Error 3021

[Marianna_Air]

It used to let me add a record. here is the entire code.


Option Compare Database
Public strTmp As String
Public strDelete As String
'Dim XObject As New EB.EBexplodeClass
' v5124
Dim XObject As Object
Option Explicit
Private Sub Command84_Click()
MsgBox Me.NewRecord
End Sub
Private Sub cmdCopyCurrentrequestforquotesID_Click()
Me.RequestforQuotesID = Me!RequestforQuotesID
End Sub
Private Sub cmdPastePOorderlines_Click()
On Error GoTo Err_Sub
Dim dbsCurrent As DAO.Database
Dim strSQL As String

If Not (Me![Status] = "1") Then
MsgBox "Authorizaton is required to change a Released, Closed or Archived PO!", vbCritical, "Unauthorized"
Exit Sub
End If

If IsNull(Me!RequestforQuotesID) Then
MsgBox "Please fill in the orange/amber fields on the first tab before autofilling.", vbCritical, "Missing Info"
Exit Sub
End If

If IsNull(Me!SupplierID) Then
MsgBox "Please fill in the Supplier on the first tab before autofilling.", vbCritical, "Missing Supplier"
Exit Sub
End If

If IsNull(Me.RequestforQuotesID) Then
MsgBox "You must select a request for quotes (RFQ Number) to copy from first!", vbCritical, "Missing PONumber"
Exit Sub
End If

Set dbsCurrent = CurrentDb()

strSQL = "INSERT INTO [Inventory Transactions] (requestforquotesID, ProductID, TransactionDescription, " _
& "TransferFromID, CustomerID, ShipFromID, ShipToID, UnitPrice, UnitPriceConv, UnitsOrdered, UnitsOrderedConv, " _
& "DateRequired, DatePromised, ModelNumber, Control, ShippingMethodID, ShippingTracking, SalesTracking, " _
& "PP, UnitsOfMeasure, TaxRate, qbTaxCode, GLAccount, ChosenCustomerID, ChosenShipToID, " _
& "DepartmentAutoID, TransactionDate, " _
& "[Currency] ) " _
& "" _
& "SELECT """ & Replace(Me!RequestforQuotesID, """", """""") & """, ProductID, TransactionDescription, " _
& "TransferFromID, CustomerID, ShipFromID, ShipToID, UnitPrice, UnitPriceConv, UnitsOrdered, UnitsOrderedConv, " _
& "DateRequired, DatePromised, ModelNumber, Control, ShippingMethodID, ShippingTracking, SalesTracking, " _
& "PP, UnitsOfMeasure, TaxRate, qbTaxCode, GLAccount, ChosenCustomerID, ChosenShipToID, " _
& "DepartmentAutoID, #" & IIf(IsNull(Me!OrderDate), Format(Now(), "Short Date"), Me!OrderDate) & "#, " _
& """" & Replace(Nz(Me![Userdefinable 2], "United States of America Dollar"), """", """""") & """ " _
& "" _
& "FROM [Inventory Transactions] " _
& "WHERE requestforquotesID = """ & Replace(Me.RequestforQuotesID, """", """""") & """ " _
& "AND TransferFromID = 0 " _
& "AND CustomerID = 0 " _
& "AND (UnitsShipped <> 0 OR UnitsShipped IS NULL) " _
& "ORDER BY TransactionID;"

dbsCurrent.Execute strSQL, dbSeeChanges

Set dbsCurrent = Nothing

Me.Request_For_Quotes_Subform.[Form].Requery

Exit_Sub:
Exit Sub
Err_Sub:
MsgBox "Error " & Err.Number & " occurred in cmdPastePOorderlines_Click()." & vbCrLf & Err.Description
Resume Exit_Sub
End Sub
Private Sub cmdInventoryValuation_Click()
DoCmd.OpenForm "InventoryValuation(generic)", , , , , , "Testing"
End Sub
Private Sub cmdPhysicalCounts_Click()

Dim newrequestforquotesID As String
Dim strSQL As String
Dim aEmployeeID As Long
Dim newSupplierID As Long
Dim strCurrency As String
Dim dbsCurrent As DAO.Database
Dim rs As DAO.Recordset
Dim lngCount As Long
Dim lngResponse As Long
Dim strProductID As String
Dim strUnitOfMeasure As String
Dim lngUofMID As Long
Dim lngUofMToID As Long
Dim strDynamicTable As String
Dim lngCustomerID As Long

On Error GoTo ERR_IMPORT

DoCmd.RunCommand acCmdSaveRecord 'To ensure data has been inserted into [request for quotes] table first

If (Not (Nz(Me.StatusID, 1) = 1)) Then
MsgBox "request for quotes my be in ""Planned"" status to auto-fill.", vbCritical, "Not Editable"
Exit Sub
End If

lngCustomerID = Nz(Me.CustomerID, 0)
If (lngCustomerID = 0) Then
MsgBox "You must fill in a Location/SubLocation on the Main tab, before auto-filling for that location.", vbCritical, "No Location Entered"
Exit Sub
End If

Set dbsCurrent = CurrentDb()

'Check if already records
Set rs = dbsCurrent.OpenRecordset("SELECT ProductID " _
& "FROM [Inventory Transactions] " _
& "WHERE requestforquotesID = """ & Me.RequestforQuotesID & """;")
lngCount = rs.RecordCount
rs.Close

If (lngCount > 0) Then
lngResponse = MsgBox("This request for quotes already has orderlines. Do you wish to continue anyways?", vbOKCancel, "Already Orderlines")
If (lngResponse = vbCancel) Then Exit Sub
End If

'First ensure all products have valid conversion factors
Set rs = dbsCurrent.OpenRecordset("SELECT Products.ProductID, Products.UnitsOfMeasure, POConversionID, " _
& "UofMToID " _
& "FROM (Products LEFT JOIN UOfMConversion " _
& "ON Products.POConversionID = UOfMConversion.ConversionID) " _
& "LEFT JOIN UnitsOfMeasure " _
& "ON UOfMConversion.UofMFromID = UnitsOfMeasure.UofmID " _
& "WHERE Products.UnitsOfMeasure <> [UnitsOfMeasure].[UnitOfMeasure] " _
& "OR UnitsOfMeasure.UnitOfMeasure IS NULL;")

If (Not (rs.RecordCount > 0)) Then
rs.Close
Set rs = Nothing
Else
lngResponse = MsgBox("Items with missing or invalid PO UnitOfMeasure have been detected." & vbCrLf _
& "These must be corrected to proceed." _
& "To auto-correct now, click ""OK""." _
& "To manually edit, or verify using Data Quality Checker, click ""Cancel"".", vbOKCancel, "Invalid Data Detected")
If (lngResponse = vbCancel) Then
rs.Close
Set rs = Nothing
Exit Sub
Else
'Correct UofM data to legitamate values
On Error Resume Next
DoCmd.SetWarnings False
DoCmd.OpenQuery "QC_Insert_Products_UnitsOfMeasure_in_UnitOfMeasur e" 'Need for S/POConversionID
DoCmd.OpenQuery "QC_Insert_DefaultConversions_in_UofMConversio n" 'Need for S/POConversionID

DoCmd.OpenQuery "Update_nullvalues_to_defaultvalues_in_POConversio nID"

If (rs.RecordCount > 0) Then
rs.MoveFirst
Do
strProductID = rs!ProductID
strUnitOfMeasure = rs!UnitsOfMeasure
lngUofMID = DLookup("UofMID", "UnitsOfMeasure", "UnitOfMeasure = """ & Replace(strUnitOfMeasure, Chr(34), Chr(34) & Chr(34)) & """")
lngUofMToID = Nz(rs!UofMToID, lngUofMID)
If (IsNull(DLookup("ConversionID", "UofMConversion", "UofMFromID = " & lngUofMID & " AND UofMToID = " & lngUofMToID))) Then
rs.Edit
rs!POConversionID = Nz(DLookup("ConversionID", "UofMConversion", "UofMFromID = " & lngUofMID & " AND UofMToID = " & lngUofMID), 0)
rs.Update
Else
rs.Edit
rs!POConversionID = Nz(DLookup("ConversionID", "UofMConversion", "UofMFromID = " & lngUofMID & " AND UofMToID = " & lngUofMToID), 0)
rs.Update
End If
rs.MoveNext
Loop Until rs.EOF
End If
rs.Close

DoCmd.SetWarnings True
MsgBox "Finished fixing UnitsOfMeasure data. Proceeding"
On Error GoTo 0
End If
End If


'passed validation checks
DoCmd.SetWarnings False
DoCmd.Hourglass True

If Not (Me![Status] = "1") Then
MsgBox "Authorizaton is required to change a Released, Closed or Archived PO!"
GoTo EXIT_IMPORT
End If

newrequestforquotesID = Me.RequestforQuotesID

newSupplierID = DLookup("SupplierID", "Suppliers", "[SupplierName] = """ & "~PHYSICALCOUNT" & """ ")
Me.SupplierID = newSupplierID

If (IsNull(Me.EmployeeID)) Then
aEmployeeID = DLookup("EmployeeID", "Employees")
Me.EmployeeID = aEmployeeID
Me.Originator = aEmployeeID
Else
aEmployeeID = Me.EmployeeID
End If

strCurrency = Nz(Me.[Userdefinable 2], "United States of America Dollar")



strDynamicTable = "InventoryTransactionsDynInv_tmpCombine"
'if all at once, Access says "Too many contiguous lines"
strSQL = "INSERT INTO [Inventory Transactions] (TransactionDate, ProductID, " _
& "requestforquotesID, TransactionDescription, " _
& "TransferFromID, CustomerID, ShipFromID, ShipToID, " _
& "UnitsOrdered, " _
& "UnitsOrderedConv, " _
& "UnitsReceivedConv, " _
& "UnitsReceived, UnitsReceivedFG, UnitPrice, " _
& "UnitPriceConv, " _
& "LevelNumber, AccountID, [WOB/O], BOMAmount, " _
& "UnitsOfMeasure, " _
& "[Currency], " _
& "PPNumber, Control, Ordered, isExported, qbExportedDate, " _
& "ChosenCustomerID, ChosenShipToID) "

Dim aDate As Date
aDate = Format(Now(), "Short Date")
strSQL = strSQL _
& "SELECT #" & aDate & "# as TransactionDate, [Products].[ProductID] as ProductID, " _
& """" & newrequestforquotesID & """ as requestforquotesID, [Products].[ProductName] as TransDescript, " _
& "0 as TransferFromID, 0 as CustomerID, 0 as ShipFromID, 0 as ShipToID, " _
& "[" & strDynamicTable & "].[PhysicalCount] as UnitsOrdered, " _
& "[" & strDynamicTable & "].[PhysicalCount] / Nz(UofMConversion.ConversionFactor, 1) as UnitsOrderedConv, " _
& "[" & strDynamicTable & "].[PhysicalCount] / Nz(UofMConversion.ConversionFactor, 1) as UnitsReceivedConv, " _
& "0 as UnitsReceived, 0 as UnitsReceivedFG, [Products].[StandardUnitPrice] as UnitPrice, " _
& "[Products].[StandardUnitPrice] * Nz(UofMConversion.ConversionFactor, 1) as UnitPriceConv, " _
& "0 as LevelNumber, 1 as AccountID, 0 as [WOB/O], 0 as BOMAmount, " _
& "iif(UofMConversion.ConversionFactor IS NULL, [Products].[UnitsOfMeasure], [UnitsOfMeasure].[UnitOfMeasure]) as UoM, " _
& """" & Replace(strCurrency, Chr(34), Chr(34) & Chr(34)) & """ as [Currency], " _
& "0 as PPNumber, ""Inventory"" as Control, #" & aDate & "# as Ordered, 1 as isExported, #" & aDate & "# AS qbExpDate, " _
& "[" & strDynamicTable & "].CustomerID, [" & strDynamicTable & "].ShipToID "

strSQL = strSQL _
& "FROM ((Products " _
& "INNER JOIN [" & strDynamicTable & "] " _
& "ON Products.ProductID = [" & strDynamicTable & "].ProductID) " _
& "LEFT JOIN UOfMConversion " _
& "ON Products.POConversionID = UOfMConversion.ConversionID) " _
& "LEFT JOIN UnitsOfMeasure " _
& "ON UnitsOfMeasure.UofMID = UOfMConversion.UofMToID;"

dbsCurrent.Execute strSQL

Set dbsCurrent = Nothing
'DoCmd.RunSQL strSQL

MsgBox "Physical Count request for quotes " & newrequestforquotesID & " has been filled in.", _
vbInformation, "Import Physical Counts"

EXIT_IMPORT:
Me.Request_For_Quotes_Subform.Requery
DoCmd.SetWarnings True
DoCmd.Hourglass False
Exit Sub
ERR_IMPORT:
MsgBox Err.Number & " " & Err.Description
Resume EXIT_IMPORT
Resume Next
End Sub
Private Sub Currency_AfterUpdate()
Dim temp As String

' save temporary date field in a variable

'If (Me![TglIncomplete].Value = True) And (Me![TxtShippedDate] <> "") Then
temp = Me![Currency]

' go to the first record

Me![request for quotes Subform].SetFocus
DoCmd.GoToRecord , , acFirst

' search through all records and set the ShippedDate to this temporary date. the last record
' is a new record; this is not filled in
While (Not Me![request for quotes Subform].Form.NewRecord)

'If (IsNull(Me![SalesOrderSubform]![ShippedDate])) And (Me![SalesOrderSubform]![ShippedDate].Locked = False) Then
Me![request for quotes Subform]![ProductsCurrency] = temp
Me![request for quotes Subform]![ITCurrency] = temp
'End If
'On Error Resume Next
DoCmd.GoToRecord , , acNext
Wend

' change records so the user is not in a new record

DoCmd.GoToRecord , , acLast

'Else
' Beep
'End If
End Sub
Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
' Suppress default Delete Confirm dialog box.
Response = acDataErrContinue
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim db As DAO.Database
Dim rst As Recordset
'Prevent changes to PO Form unless Planned
If Not ((Me![Status] = "1") Or (Me![Status].OldValue = "1")) Then
MsgBox ("Authorizaton is required to change a Released, Closed, Archived RFQ!")
'DoCmd.CancelEvent
Me.Undo
Location.Requery
Exit Sub
End If
Set db = CurrentDb()
Set rst = db.OpenRecordset("SELECT * FROM [Inventory Transactions] WHERE [Inventory Transactions].[requestforquotesID] = """ & Me.RequestforQuotesID & """ AND [Inventory Transactions].[TransferFromID] <> 0", dbOpenDynaset, dbSeeChanges)
If Not (rst.EOF) Then rst.MoveFirst
If (rst.RecordCount > 0) Then
If (vbCancel = MsgBox("Receipts already made against this PO... Continue", vbOKCancel, "Warning")) Then
Me.Undo
Location.Requery
Exit Sub
End If
End If
End Sub
Private Sub Form_Close()
Me.Filter = "StatusID <> 7"
End Sub
Private Sub Form_Current()
strTmp = IIf(IsNull(Me!RequestforQuotesID), "Null", Me!RequestforQuotesID)
Location.Requery
DoCmd.Maximize
'PrepareITtmpForSubform (strTmp)
If (IsEditable) Then
Me.AllowEdits = True
Me.Request_For_Quotes_Subform.Locked = False
Else
Me.AllowEdits = False
Me.Request_For_Quotes_Subform.Locked = True
End If
End Sub
Private Sub Form_Activate()

On Error GoTo Err_Form_Activate
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Exit_Form_Activate:
Exit Sub
Err_Form_Activate:
MsgBox Err.Description
Resume Exit_Form_Activate
End Sub
Private Sub Form_Delete(Cancel As Integer)
strTmp = Me!RequestforQuotesID
strDelete = strTmp
' SUB - before confirm delete
' Suppress default Delete Confirm dialog box.
'Response = acDataErrContinue
' Display custom dialog box.
If MsgBox("Delete this record? " & strDelete, vbOKCancel) = vbCancel Then
Cancel = True
Exit Sub
End If
Dim dbsCurrent As DAO.Database
Dim strrequestforquotesID As String
Dim wrkJet As DAO.Workspace
Set dbsCurrent = CurrentDb()

DoCmd.Hourglass True
'dbsCurrent.Execute "DELETE * FROM [Sales Orders] WHERE ([Sales Orders].[SalesOrderID]=""" & strSalesOrderID & """);"
dbsCurrent.Execute "DELETE * FROM [Inventory Transactions] " _
& "WHERE ([Inventory Transactions].[requestforquotesID] =""" & strDelete & """);", dbSeeChanges
DoCmd.Hourglass False
'SUB - after delete confirm
MsgBox "Deletion occurred normally."
End Sub
Private Sub Form_LostFocus()
On Error Resume Next
strTmp = Me!RequestforQuotesID
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim db As DAO.Database
DoCmd.SetWarnings False
Set db = CurrentDb()
db.Execute "DELETE * FROM Products_Search;"
db.Execute "Products_Search_Fill"
DoCmd.SetWarnings True
Set db = Nothing

Me.Filter = "StatusID <>7"
DoCmd.ApplyFilter "request for quotes(inventory)", "StatusID <>7"
End Sub
Private Sub Form_Unload(Cancel As Integer)

' v5124
Set XObject = Nothing
End Sub
Private Sub ItemFind_Click()
If Not IsNull([ItemLookUP]) Then
RequestforQuotesID.SetFocus
DoCmd.FindRecord ([ItemLookUP])
ItemLookUP.SetFocus
Else
MsgBox "Please enter a request for quotes to go to."
End If
End Sub
Private Sub ItemLookUP_GotFocus()
Me.AllowEdits = True
End Sub


Private Sub ItemLookUP_LostFocus()
If (Not (IsEditable)) Then
Me.AllowEdits = False
Me.Request_For_Quotes_Subform.Locked = True
End If
End Sub
Private Sub ItemLookUpArchived_GotFocus()
Me.AllowEdits = True
End Sub
Private Sub ItemLookUpArchived_LostFocus()
If (Not (IsEditable)) Then
Me.AllowEdits = False
Me.Request_For_Quotes_Subform.Locked = True
End If
End Sub
Private Sub ItemUnArchive_Click()
If Not IsNull([ItemLookUpArchived]) Then
Dim dbsCurrent As DAO.Database
Dim strIDtmp As String
Set dbsCurrent = CurrentDb
strIDtmp = ItemLookUpArchived
'Set the status to "Closed" so it can be displayed"
dbsCurrent.Execute "UPDATE [request for quotes] " _
& "SET StatusID = 4 " _
& "WHERE requestforquotesID = """ & strIDtmp & """;"
'Make sure the form & comboboxes have the data updated
Me.Requery
Me.ItemLookUpArchived.Requery
Me.ItemLookUP.Requery


RequestforQuotesID.SetFocus
DoCmd.FindRecord ([strIDtmp])
ItemLookUP.SetFocus
Else
MsgBox "Please enter a request for quotes to UnArchive."
End If
End Sub
Private Sub Location_GotFocus()
Location.Requery
End Sub
Private Sub OrderDate_AfterUpdate()
Dim aDB As DAO.Database
If (IsNull(Me.OrderDate)) Then
Me.OrderDate = Format(Now(), "Short Date")
Else
Me.OrderDate = Format(Me.OrderDate, "Short Date")
End If
If Not (IsNull(Me.OrderDate)) Then
Set aDB = CurrentDb()
aDB.Execute "UPDATE [Inventory Transactions] SET [TransactionDate] = #" & Me.OrderDate & "# " _
& "WHERE [requestforquotesID] = '" & Me.RequestforQuotesID & "';", dbSeeChanges
Set aDB = Nothing
End If
End Sub
Private Sub Purchase_Orders_Subform_Enter()

'Prevent user to create request for quotes Item without creating a request for quotes first

If IsNull(Me!SupplierID) Then
MsgBox "You must fill in the request for quotes information first before filling any request for quotes item"
Me![SupplierID].SetFocus
Exit Sub
End If

If IsNull(Me![RequestforQuotesID]) Then
Me![OrderDate] = Date
End If

End Sub
Private Sub Preview_Click()
On Error GoTo Err_Preview_Click
Me.Refresh
If IsNull(Me![RequestforQuotesID]) Then
MsgBox "Enter request for quotes information before previewing."
Else
'DoCmd.OpenReport "request for quotes", acPreview, , "[request for quotes].[requestforquotesID]= """ & Me![requestforquotesID] & """"
DoCmd.OpenReport "requestforquotes_Converted", acPreview, , "[request for quotes].[requestforquotesID]= """ & Me![RequestforQuotesID] & """"
End If
Exit_Preview_Click:
Exit Sub
Err_Preview_Click:
If Err <> 2501 And Err <> 2465 Then
MsgBox Err.Description
End If
Resume Exit_Preview_Click
End Sub
Private Sub requestforquotesID_BeforeUpdate(Cancel As Integer)
Dim decision As Integer
Dim prefix As String
Dim strValue As String
Dim strSQL As String
Dim rstID As DAO.Recordset
Dim dbsCurrent As Database

Set dbsCurrent = CurrentDb()

decision = MsgBox("Do you really want to change the ID of this request for quotes?", vbYesNo)
If decision = 7 Then
Me.Undo
Else
If IsNull(Me!RequestforQuotesID) Then
MsgBox "Cannot replace request for quotes ID with a null value", vbOKOnly
Me.Undo
Exit Sub
End If
prefix = Left(Forms![request for quotes(inventory)]!RequestforQuotesID.Value, 2)
If prefix <> "RFQ" Then
MsgBox "Your ID is invalid. It must begin with RFQ.", vbOKOnly
Me.Undo
Else
strValue = Me!RequestforQuotesID
strSQL = "SELECT * FROM [request for quotes] WHERE ([request for quotes]![requestforquotesID] = """ & strValue & """)"
Set rstID = dbsCurrent.OpenRecordset(strSQL)
If rstID.RecordCount <> 0 Then
MsgBox "This ID value already exists.", vbOKOnly
Me.Undo
End If
rstID.Close
End If
End If
End Sub
Private Sub ShipTo_AfterUpdate()
'Location.Requery
'Location = Location.ItemData(0)
'Update Serial Number !Location for Serial Numbers already added to request for quotes
Me.Refresh
End Sub
Private Sub Status_BeforeUpdate(Cancel As Integer)
If (IsEditable) Then
If (Me!Status.OldValue > 1 And Me!Status = 1) Then
Dim db As DAO.Database
Dim rst As Recordset
Set db = CurrentDb()
Set rst = db.OpenRecordset("SELECT * FROM [Inventory Transactions] WHERE [Inventory Transactions].[requestforquotesID] = """ & Me.RequestforQuotesID & """ AND [Inventory Transactions].[TransferFromID] <> 0", dbOpenDynaset, dbSeeChanges)
If Not (rst.EOF) Then rst.MoveFirst
If (rst.RecordCount > 0) Then
If (vbCancel = MsgBox("Receipts already made against this PO... Continue", vbOKCancel, "Warning")) Then
Me.Undo
Location.Requery
Exit Sub
End If
End If
rst.Close
Set rst = Nothing
Set db = Nothing
End If
End If
End Sub
Private Sub Status_GotFocus()
Me.AllowEdits = True
End Sub
Private Sub Status_LostFocus()
If (Not (IsEditable)) Then
Me.AllowEdits = False
Me.Request_For_Quotes_Subform.Locked = True
End If
End Sub
Private Sub StatusCriteria_AfterUpdate()
Dim strPOID As String
strPOID = Nz(Me!RequestforQuotesID, "RFQXXXX")
Me.FilterOn = False
Select Case StatusCriteria
Case 1:
Me.Filter = "StatusID <>7"
'DoCmd.ApplyFilter "request for quotes(inventory)", "StatusID <>7"
Case 2:
Me.Filter = ""
'DoCmd.ApplyFilter "request for quotes(inventory)", ""
Case 3:
Me.Filter = "StatusID =7"
'DoCmd.ApplyFilter "request for quotes(inventory)", "StatusID =7"
End Select
Me.FilterOn = True
Me.Requery
Me.ItemLookUP.Requery
RequestforQuotesID.SetFocus
'If there are any records in the current recordset, then try to find last CurrentRecord
On Error Resume Next
If (Not (Me.CurrentRecord = 1 And Me.NewRecord = -1)) Then DoCmd.FindRecord ([strPOID])
'MsgBox "currentrecord = " & Me.CurrentRecord & " NewRec = " & Me.NewRecord
End Sub
Private Sub SupplierID_AfterUpdate()


Dim dbsCurrent As DAO.Database
Dim strTmp As String

'Update records in IT table if SupplierID is changed after it is used to make records
'If (IsNull(Me.SupplierID.OldValue)) Then Exit Sub

' v5147
' ************************************************** ******************************
If Not (Me![Status] = "1") Then
MsgBox ("Authorizaton is required to change a Released, Closed or Archived PO!")
Me.Undo
Exit Sub
End If

' v5147 - Update Currency Unit on Transaction records
' ************************************************** ******************************
strTmp = Nz(DLookup("[CurrencyUnit]", "[Suppliers]", "[Suppliers].[SupplierID] = " & Me!SupplierID), "")
If strTmp = "" Then strTmp = DLookup("[Base Currency]", "[My Company Information]")
Me.Currency.Value = strTmp

' 'v5147 - Update UnitPriceConv on Transaction records based on the currency factor
' ************************************************** ******************************
Dim lgFactor As Double
lgFactor = Nz(DLookup("[Factor]", "[Currency]", "[Currency].[FullName] = """ & Me.Currency.Value & """"), 1)
'MsgBox lgFactor, , "lgFactor"
Me![request for quotes Subform].SetFocus
DoCmd.GoToRecord , , acFirst
While (Not Me![request for quotes Subform].Form.NewRecord)
Me![request for quotes Subform]![UnitPriceConv] = Me![request for quotes Subform]![UnitPrice] / lgFactor
Me![request for quotes Subform]![ITCurrency] = Me![Currency]
DoCmd.GoToRecord , , acNext
Wend
DoCmd.GoToRecord , , acLast

Set dbsCurrent = CurrentDb
dbsCurrent.Execute ("UPDATE [Inventory Transactions] " _
& "SET [Currency] = """ & strTmp & """" _
& "WHERE [Inventory Transactions].[requestforquotesID] = """ & Me!RequestforQuotesID & """ ;")
Set dbsCurrent = Nothing

'If Not IsNull(SupplierID) Then MsgBox "Please update the vendor number fields in the chart below if you are changing the Supplier."
Me.Request_For_Quotes_Subform!VendorNumber.Requery
Me.Request_For_Quotes_Subform!IT_UnitPriceConv.Req uery
Me.Request_For_Quotes_Subform!ITCurrency.Requery

End Sub
Private Function IsEditable() As Integer
'if (this is a earlier Rev than last) then don't let users change it.
Dim dbsCurrent As DAO.Database
Dim rstTmp As DAO.Recordset
Dim strTmpID As String
Set dbsCurrent = CurrentDb
Dim isRev As Boolean
strTmpID = Me!RequestforQuotesID
If (Mid(Me!RequestforQuotesID, Len(Me!RequestforQuotesID) - 1, 1) = "^") Then
strTmpID = Left(Me!RequestforQuotesID, Len(Me!RequestforQuotesID) - 2)
isRev = True
Else
isRev = False
End If
Set rstTmp = dbsCurrent.OpenRecordset("SELECT requestforquotesID " _
& "FROM [request for quotes] " _
& "WHERE requestforquotesID = """ & strTmpID & """ " _
& "OR requestforquotesID LIKE """ & strTmpID & "^*"" " _
& "ORDER BY requestforquotesID;")
If (rstTmp.RecordCount > 0) Then
rstTmp.MoveLast
If (Me!RequestforQuotesID <> rstTmp!RequestforQuotesID) Then
IsEditable = False
Else
IsEditable = True
End If
Else
IsEditable = True
End If '(rstTmp.RecordCount > 0)
rstTmp.Close
dbsCurrent.Close
Set dbsCurrent = Nothing
End Function

[ssanfu]

@Marianna_Air: I haven't waded through the entire code.... I did miss the function declaration:

Private Function IsEditable() As Integer

should be

Private Function IsEditable() As Boolean


@Orange - the full function was posted at post#1. The code seems to execute.....

I did some changes, but apparently there is still an error at the line:
If (Mid(strTmpID, Len(strTmpID) - 1, 1) = "^") Then

[orange]

Hi Steve, I sort of looked at this at about post 13. I saw the bright red and took a look. I saw a function but it didn't set a return value.
Anyway, you're familiar with the post so I will move on and leave it in with you.

Yes, I thought it a little strange looking for a "^" in 2nd rightmost position??

[ssanfu]

I'm guessing that if the RFQ number has a "^" or "^*" at the end it still a quote and not a "buy/sell".

Don't move too far..... two heads are better than one, especially when mine is a cabbage...

[Marianna_Air]

I really do appreciate the help guys!!, this is all I've been staring at for about 2 weeks now. I just can't figure it out. Everything else seems to be working just fine except the add a record button. I've even gone back to the original database to see if I missed something, but nothing I could see, I thought that maybe it would have something to do with the original being a 2003 database???

[orange]

Tell us more about the use of "^".

[Marianna_Air]

I wish I could, I'm very much a novice at this. I thought maybe it represented the "RFQ" part of my record number, so I tried to change it to "^^^*" thinking maybe it would give me a record like "RFQ12345". the original database had a record like this "PO12345" so I'm stumped as to why changing it to "RFQ" has proven to be such a pain

all the tables work, and the query seems to work, it's just the form that will not work, is there anything else I can show you????

[orange]

Well, speaking frankly from my position, I don't know your application. I'm not sure what your business process(es) is/are, nor do I have any familiarity with your Form and what it represents. We can respond to design questions, offer some advice/alternatives to approaches etc, but we/ I am not in position to decipher your processes and the forms used to support the process. If you don't know what or why the code is working with the "^", and you're working in the "business environment", then you'll have to do some investigating at your end. At this point you are dealing with the HOW side -- that is how is something being done. You need to focus on WHAT -- what is the business process/function that this form is supporting? What is the purpose of the "^" character? In general, WHAT is the bigger picture, so we might look at details or alternatives. We need more business "facts" in order to understand WHAT it is your code is attempting to do.

You could try posting a "dumbed down" version of your database. But I have 2003 and can only use mdb format. Someone with 2007 2010 might respond to an accdb database.

Good luck.

[Marianna_Air]

Well I may have found something, while I was diligently digging through my database trying to find out what the ^ was supposed to represent, I found this =GetNextSN("RFQ") just to see what would happen I put the original letters PO back into it =GetNextSN("PO") and now my new record button works but I get a PO12345,what I want it to say RFQ12345,
I have to be missing something here

[orange]

Post the code for the GetNextSN() function.

[Marianna_Air]

This all I could find,

Public Function GetRFQID() As String

On Error GoTo Err_Sub
Dim dbs As DAO.Database
Dim rsCheck As DAO.Recordset
Dim lngCustomerID As Long
Dim strRFQID As String
Dim lngSupplierID As Long
Dim strCurrency As String
Dim lngShipToID As Long
Dim strDate As String

GetRFQID = ""

Set dbs = CurrentDb

Set rsCheck = dbs.OpenRecordset("SELECT RFQID " _
& "FROM [REQUEST FOR QUOTESs] " _
& "WHERE RFQID LIKE ""rfq*"" " _
& "AND StatusID = 1 " _
& "AND [UserDefinable 1] = ""PhysicalCount"";")

If (rsCheck.RecordCount < 1) Then
strRFQID = ""
Else
rsCheck.MoveFirst
strRFQID = Nz(rsCheck!RFQID, "")
End If
rsCheck.Close


If (strRFQID = "") Then
lngCustomerID = 1 '~STORES , But can easily be others
lngShipToID = 1 'STORES , But can easily be others
lngSupplierID = Nz(DLookup("SupplierID", "Suppliers", "SupplierName = '~PHYSICALCOUNT'"), 0)
strCurrency = Nz(DLookup("[Base Currency]", "[My Company Information]"), "United States of America Dollar")
strDate = Format(Now(), "Short Date")

strRFQID = GetNextSN("RFQ")
dbs.Execute "INSERT INTO [REQUEST FOR QUOTES] ( RFQID, [UserDefinable 1], StatusID, OrderDate, " _
& "SupplierID, [UserDefinable 2], " _
& "CustomerID, CustomerShipToID, TransferDate, PST ) " _
& "VALUES ( """ & strRFQID & """, ""PhysicalCount"", 1, #" & strDate & "#, " _
& lngSupplierID & ", """ & ReplaceString(strCurrency, Chr(34), Chr(34) & Chr(34)) & """, " _
& lngCustomerID & ", " & lngShipToID & ", #" & strDate & "#, 1 )", dbSeeChanges

End If
GetRFQID = strRFQID
Exit_Sub:
Exit Function
Err_Sub:
MsgBox "Error " & Err.Number & " occurred in GetRFQID: " & Err.Description
Resume Exit_Sub
End Function

[Marianna_Air]

I figured it out finally, I had a table called "SN" that I had ignored until today, because when I started this endeavor I checked the dependencies of this table and it had "NO" dependencies, it depended on nothing and nothing depended on it. So I was going to trash it but never got around to it luckily.

I’m confused as to how a table can have no dependencies and depend on nothing but still be needed, shouldn't it have shown "table XXX depends on me"

I thank you all for your time and help

Kevin

[orange]

Do not TRASH (DELETE) anything as a first step.

You could change the name of something - for example table SN to SN_X - and document what you did. If there's an error like
can't find table SN appears you can go to you "Hold for possible Delete list" and reinstate table SN. Just a sample. This is especially true
if you are taking over a system with little/no documentation.

The other things you could do:
- go to any module in design view; go to edit ->Find; put in the search string SN do a find next; It may just be referenced in vba.

-get a copy of the free utility MZTools http://www.mztools.com/v3/download.aspx and use it to help with documentation; automating code for error handling;
find out what Calls a procedure; etc.


If you found GetNextSN, then it was probably (and may still be) used somewhere in your application.
You should document whatever you find, so that next time there's a change, you won't be hunting blindly.

Good luck with your project.