Mystery event driven data source to bound TextBox controls

EE Experts:

If you are looking for some quick easy points, you might want to take a pass on this question because in my opinion this is not going to be easy or quick.

I inherited maintainence responsibility for an MS-Access 2003 Order Tracking application. The processing of Wholesale Orders was cloned from working Retail Order processing functionality. In my opinion cloning that uses the "Bucket Metaphor" is a mistake, but I have to live with what I inherited. The processing of Wholesale Orders works but is flawed in that it will not allow the user to capture new customer contact information while entering a new order. Retail Order processing will allow the user to capture new customer contact information while entering a new order. It's done this way for the sake of efficiency. So therefore, in order for the user to enter a new Wholesale customer order, they have to use the MS-Access IDE to jam the new customer data into the [Wholesale Accounts] table before they can enter the new Wholesale Order. I am trying to fix that.

Here is what is happening for which I have yet to discover an explaination so I can fix it. I hope you can change that. On the Retail side, I can click the "New Retail Order" command button from the main menu and bring up the Retail Order form with the "Bill to" combo box blank. I can then tab or click into any of the Customer Contact Information TextBoxes. I can enter data in those TextBoxes and while doing that the "Bill to" ComboBox remains blank. I can continue entering data until all the order details are complete including the "Ship to" contact information. I can then click on the "Print" command button, on the order entry form, the click event script for which: prints the order and saves the collected data in all the correct tables.

When I click the "New Wholesale Order" command button from the main menu and bring up the Wholesale Order form with the "Bill to" combo box blank; tab or click into any of the Customer Contact Information TextBoxes and begin entering data; as soon as I stroke the first key, the "Bill to" combo box goes to the first record in the form's data source and the Customer Contact Information TextBoxes get populated with the data of the first data source record columns they are bound to. It is not supposed to happen this way if the Wholesale order entry process is just like the Retail order entry process. Thus far I have not been successful at finding the event script that is making this happen. So that is my question. Can you give me any clues as to what event script is causing this bad behavior?

I have analyzed all the event scripts for each of the Customer Contact Information text boxes, and found none that would cause this kind of bad behavior. There is an event script for Retail Form On Key Down event which I copied to the Wholesale Form On Key Down event script commenting out the controls that are not in scope on the Wholesale form. I see nothing in the Key Down event scripts for either form that would explain the bad behavior that I am observing. I believe I have included all pertainent event scripts in the Code attachment.

Of course I will be thrilled to respond with any additional information that you might need.

Thank you,
Ted Palmer
Retail Orders Query:
 
SELECT Orders.CustomerID, Orders.ID, Orders.OrderID, Orders.EmployeeID, Orders.OrderDate, Orders.Time, Orders.OrderMode, Orders.PaymentAmount, Orders.CheckNum, Orders.PaymentDate, Orders.PrintStatus, Customer.FirstName, Customer.LastName, Customer.Address, Customer.Address2, Customer.City, Customer.StateOrProvince, Customer.PostalCode, Customer.Country, Customer.Phone, Customer.Email, Customer.ShipNotification, Customer.[CC#], Customer.[AMEX#], Customer.CCType, Customer.ExpDate, Customer.BankName, Customer.ABARoutingCode, Customer.AccountNumber, Orders.TotalFreight, Orders.OrderSubtotal, Orders.PaymentNotes, Orders.CheckAmount, Orders.PaymentType, Customer.Coupons, Orders.TaxRate, Orders.Credit, Orders.Coupon, Customer.Notes
FROM Customer INNER JOIN Orders ON Customer.ID = Orders.CustomerID
ORDER BY Orders.OrderID;
 
++++++++++++
Wholesale Orders Query:
 
SELECT [Wholesale Orders].OrderDate, [Wholesale Orders].Time, [Wholesale Orders].ID, [Wholesale Orders].OrderID, [Wholesale Orders].LocationID, [Wholesale Orders].EmployeeID, [Wholesale Orders].OrderMode, [Wholesale Orders].PrintStatus, [Wholesale Accounts].Phone, [Wholesale Orders].Contact, [Wholesale Accounts].CompanyName, [Wholesale Accounts].Address, [Wholesale Accounts].Address2, [Wholesale Accounts].City, [Wholesale Accounts].StateOrProvince, [Wholesale Accounts].PostalCode, [Wholesale Accounts].Country, [Wholesale Accounts].Fax, [Wholesale Accounts].Email, [Wholesale Accounts].ShipNotification, [Wholesale Orders].Credit, [Wholesale Orders].PaymentNote, [Wholesale Orders].TotalFreight, [Wholesale Orders].OrderSubtotal, [Wholesale Orders].PurchaseOrderNo, [Wholesale Accounts].Notes
FROM [Wholesale Accounts] INNER JOIN [Wholesale Orders] ON [Wholesale Accounts].ID = [Wholesale Orders].LocationID
ORDER BY [Wholesale Orders].OrderDate, [Wholesale Orders].Time, [Wholesale Orders].OrderID;
 
++++++++++++
Retail "BillTo" ComboBox On NotInList event script
 
Private Sub BillTo_NotInList(NewData As String, Response As Integer)
 
Const conClrWhite = 16777215
Const conNormal = 1
 
If (IsNull(CustomerID) Or CustomerID = 0) Then
 
    BillTo.Undo
 
    CouponCredits = OrderID
 
    Phone.Enabled = True
    Phone.Locked = False
    Phone = NewData
 
    FirstName.Enabled = True
    FirstName.Locked = False
    FirstName.BackColor = conClrWhite
    FirstName.BorderStyle = conNormal
    FirstName.SetFocus
    LastName.Enabled = True
    LastName.Locked = False
    Address.Enabled = True
    Address.Locked = False
    Address2.Enabled = True
    Address2.Locked = False
    City.Enabled = True
    City.Locked = False
    StateOrProvince.Enabled = True
    StateOrProvince.Locked = False
    PostalCode.Enabled = True
    PostalCode.Locked = False
    Country.Enabled = True
    Country.Locked = False
    Email.Enabled = True
    Email.Locked = False
    ShipNotification.Enabled = True
    ShipNotification.Locked = False
 
    Response = acDataErrContinue
 
End If
 
End Sub
 
++++++++++++
Wholesale "BillTo" ComboBox On NotInList event script
 
Private Sub BillTo_NotInList(NewData As String, Response As Integer)
Dim intNewCustomer As Integer, strTitle As String
Const conClrWhite = 16777215
Const conNormal = 1
 
If (IsNull() Or CustomerID = 0) Then
 
    BillTo.Undo
 
    Phone.Enabled = True
    Phone.Locked = False
    Phone = NewData
 
    Contact.Enabled = True
    Contact.Locked = False
    Contact.BackColor = conClrWhite
    Contact.BorderStyle = conNormal
    Contact.SetFocus
    CompanyName.Enabled = True
    CompanyName.Locked = False
    Address.Enabled = True
    Address.Locked = False
    Address2.Enabled = True
    Address2.Locked = False
    City.Enabled = True
    City.Locked = False
    StateOrProvince.Enabled = True
    StateOrProvince.Locked = False
    PostalCode.Enabled = True
    PostalCode.Locked = False
    Country.Enabled = True
    Country.Locked = False
    Email.Enabled = True
    Email.Locked = False
    ShipNotification.Enabled = True
    ShipNotification.Locked = False
 
    Response = acDataErrContinue
 
End If
 
End Sub
 
++++++++++++
Retail Form On Key Down event script
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
 
If KeyCode = 65 And Shift = 2 Then
 
DoCmd.GoToRecord , , acNewRec
 
End If
 
If KeyCode = 83 And Shift = 2 Then
 
Forms!Orders![Packages subform]!ShipFirstName.SetFocus
 
End If
 
If KeyCode = 71 And Shift = 2 Then
 
On Error GoTo Err_GiftMessageButton_Click
 
    Dim stDocName1 As String
    Dim stLinkCriteria1 As String
 
    stDocName1 = "GiftMessage"
    
    stLinkCriteria1 = "[PackageID]=" & Forms!Orders![Packages subform]![PackageID]
    DoCmd.OpenForm stDocName1, , , stLinkCriteria1
 
Exit_GiftMessageButton_Click:
    Exit Sub
 
Err_GiftMessageButton_Click:
    MsgBox Err.Description
    Resume Exit_GiftMessageButton_Click
 
End If
 
If KeyCode = 84 And Shift = 2 Then
 
On Error GoTo Err_TrackingInfoButton_Click
 
    Dim stDocName2 As String
    Dim stLinkCriteria2 As String
 
    stDocName2 = "Tracking"
    
    stLinkCriteria2 = "[ShipmentID]=" & "'" & Me![ShipmentID] & "'"
    DoCmd.OpenForm stDocName2, , , stLinkCriteria2
 
Exit_TrackingInfoButton_Click:
    Exit Sub
 
Err_TrackingInfoButton_Click:
    MsgBox Err.Description
    Resume Exit_TrackingInfoButton_Click
 
End If
 
End Sub
 
++++++++++++
Wholesale Form On Key Down event script
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 65 And Shift = 2 Then
 
DoCmd.GoToRecord , , acNewRec
 
End If
 
If KeyCode = 83 And Shift = 2 Then
 
Forms!WholesaleOrders![Wholesale subform]!ShipFirstName.SetFocus
 
End If
 
If KeyCode = 71 And Shift = 2 Then
 
On Error GoTo Err_GiftMessageButton_Click
 
    Dim stDocName1 As String
    Dim stLinkCriteria1 As String
 
    stDocName1 = "GiftMessage"
    
    'stLinkCriteria1 = "[PackageID]=" & Forms!WholesaleOrders![WholesaleDetailsExtended subform]![PackageID]
    'DoCmd.OpenForm stDocName1, , , stLinkCriteria1
 
Exit_GiftMessageButton_Click:
    Exit Sub
 
Err_GiftMessageButton_Click:
    MsgBox Err.Description
    Resume Exit_GiftMessageButton_Click
 
End If
 
If KeyCode = 84 And Shift = 2 Then
 
On Error GoTo Err_TrackingInfoButton_Click
 
    Dim stDocName2 As String
    Dim stLinkCriteria2 As String
 
    stDocName2 = "Tracking"
    
    'stLinkCriteria2 = "[ShipmentID]=" & "'" & Me![ShipmentID] & "'"
    'DoCmd.OpenForm stDocName2, , , stLinkCriteria2
 
Exit_TrackingInfoButton_Click:
    Exit Sub
 
Err_TrackingInfoButton_Click:
    MsgBox Err.Description
    Resume Exit_TrackingInfoButton_Click
 
End If
 
End Sub

Open in new window

RetailOrderFormPart.PNG
RetailOrderQuery.PNG
WholesaleOrderFormPart.PNG
WholesaleOrderQuery.PNG
Ted PalmerInformation Technology ConsultantAsked:
Who is Participating?
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
<I don't believe you will see them represented in the script event code unless there is code for an event on that TextBox. Only one or two of the textboxes has any script at all, and the script make no reference to changing the current record.>

Yes, but you said you reviewed the Event code for those textboxes, and I don't see any code for those textboxes, which was the reason I asked.

I don't see anything that jumps out at me, and without being able to review the database in action it's somewhat futile for us to continue. There are many different things that can cause this sort of behavior ...

The next step would be to set Breakpoints throughout your code until you can pinpoint exactly when the issue occurs. I'd start in the Key Down/Up events, and the Form events ... set breakpoints, then walk through the code until you find where the error is being thrown.

<I couldn't possible upload the database files (FrontEnd and BackEnd). It would be impossible for me to clear out the customer data -- About 44,000 orders since year 2001.>

Its pretty simple to delete the data in a table .. just open it, then click Edit - Select All Records and hit the Delete key ... but I certainly understand you not being able to upload ...

0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
I would suspect this is coming from one of the Form events (i.e. Before/After Update, Current, Before/After Insert, etc etc). These events fire at various times, and code in any of those events could be affecting the way the app works. Without detailed info, however, it's hard to say.

can you review the code in the Form events and post it here?
0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
LSMConsulting:

Thank you for your response. I put the event code for both forms in the snippet attached. I marked them with a Subtitle underlined with pluses "+++++++++++". Just for the record. When I tested, it didn't matter which TextBox I was typing into. They all had the same effect. As soon as I stroked the first character on the Wholesale Order entry form, the "Bill to" ComboBox went to the first record of it's data source and all the rest of the fields were populated with whatever value was in the column they were bound to of the first form data source record. The Retail data entry form did not behave this way.

Ted Palmer
Retail event code All:
++++++++++++++++++++++
Option Compare Database  ' Use database order for string comparisons.
Option Explicit  ' Requires variables to be declared before they are used.
 
Private Sub Address_AfterUpdate()
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipAddress = Address
End If
 
End Sub
 
Private Sub Address2_AfterUpdate()
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipAddress2 = Address2
End If
 
End Sub
 
Private Sub BillTo_AfterUpdate()
Dim strCouponCredits As String, strCharacter As String, intLength As Integer
Dim strArray() As String, strTemp As String
Dim innerCounter As Integer, outerCounter As Integer, intCouponCount As Integer
Dim strFilter As String
 
 
Me!CustomerEdit = -1
 
If MsgBox("Ship this order to customer's billing address?", vbYesNoCancel, "Update Orders?") = vbYes Then
Me!BillingEqualsShipping = -1
Forms!Orders![Packages subform]!ShipPhone = Phone
Forms!Orders![Packages subform]!ShipFirstName = FirstName
Forms!Orders![Packages subform]!ShipLastName = LastName
Forms!Orders![Packages subform]!ShipAddress = Address
Forms!Orders![Packages subform]!ShipAddress2 = Address2
Forms!Orders![Packages subform]!ShipCity = City
Forms!Orders![Packages subform]!ShipRegion = StateOrProvince
Forms!Orders![Packages subform]!ShipPostalCode = PostalCode
Forms!Orders![Packages subform].SetFocus
Forms!Orders![Packages subform]![PackageDetailsExtended subform].SetFocus
Forms!Orders![Packages subform]![PackageDetailsExtended subform]!ProductID.SetFocus
Else
Forms!Orders![Packages subform].SetFocus
Forms!Orders![Packages subform]!ShipFirstName.SetFocus
End If
 
If ((OrderMode < 7) And StateOrProvince = "MO") Then
Forms!Orders!TaxRate = 0.07225
End If
 
'Begin Coupon Credits
 
If Not IsNull(Me![CouponCredits]) Then
 
strCouponCredits = Me![CouponCredits]
intLength = Len(strCouponCredits)
outerCounter = 0
intCouponCount = 0
 
While outerCounter < intLength
    outerCounter = outerCounter + 1
    innerCounter = 0
    strTemp = ""
    strCharacter = Mid(strCouponCredits, outerCounter, 1)
    
    While (strCharacter = "0" Or strCharacter = "1" Or strCharacter = "2" Or strCharacter = "3" Or strCharacter = "4" Or strCharacter = "5" Or strCharacter = "6" Or strCharacter = "7" Or strCharacter = "8" Or strCharacter = "9")
        innerCounter = innerCounter + 1
        strTemp = strTemp & strCharacter
        strCharacter = Mid(strCouponCredits, outerCounter + innerCounter, 1)
    Wend
    
    If (innerCounter <> 0) Then
        intCouponCount = intCouponCount + 1
        ReDim Preserve strArray(intCouponCount)
        strArray(intCouponCount) = strTemp
    End If
    
    outerCounter = outerCounter + innerCounter
    
Wend
 
outerCounter = 1
strFilter = ""
 
If intCouponCount > 4 Then
 
CouponCredits = Me!OrderID
Forms!Orders![Packages subform]![PackageDetailsExtended subform]!Discount.DefaultValue = 0
Coupon = strArray(intCouponCount)
 
Else
 
If intCouponCount > 0 Then
 
Forms!Orders![Packages subform]![PackageDetailsExtended subform]!Discount.DefaultValue = 0
Coupon = strArray(intCouponCount)
strFilter = strArray(1)
 
For outerCounter = 2 To intCouponCount
strFilter = strFilter & ", " & strArray(outerCounter)
Next outerCounter
 
CouponCredits = strFilter & ", " & Me!OrderID
 
'This Else statement is necessary for Null case
 
Else
 
CouponCredits = Me!OrderID
Forms!Orders![Packages subform]![PackageDetailsExtended subform]!Discount.DefaultValue = 0
 
End If
 
End If
 
Else
 
CouponCredits = Me!OrderID
Forms!Orders![Packages subform]![PackageDetailsExtended subform]!Discount.DefaultValue = 0
 
End If
 
End Sub
 
Private Sub BillTo_NotInList(NewData As String, Response As Integer)
 
Const conClrWhite = 16777215
Const conNormal = 1
 
If (IsNull(CustomerID) Or CustomerID = 0) Then
 
    BillTo.Undo
 
    CouponCredits = OrderID
 
    Phone.Enabled = True
    Phone.Locked = False
    Phone = NewData
 
    FirstName.Enabled = True
    FirstName.Locked = False
    FirstName.BackColor = conClrWhite
    FirstName.BorderStyle = conNormal
    FirstName.SetFocus
    LastName.Enabled = True
    LastName.Locked = False
    Address.Enabled = True
    Address.Locked = False
    Address2.Enabled = True
    Address2.Locked = False
    City.Enabled = True
    City.Locked = False
    StateOrProvince.Enabled = True
    StateOrProvince.Locked = False
    PostalCode.Enabled = True
    PostalCode.Locked = False
    Country.Enabled = True
    Country.Locked = False
    Email.Enabled = True
    Email.Locked = False
    ShipNotification.Enabled = True
    ShipNotification.Locked = False
 
    Response = acDataErrContinue
 
End If
 
End Sub
 
Private Sub CardNum_Exit(Cancel As Integer)
 
ExpDate.SetFocus
 
End Sub
 
Private Sub CCType_Exit(Cancel As Integer)
 
If CCType = "AMEX" Then
 
AMEXNum.SetFocus
 
End If
 
End Sub
 
Private Sub CheckButton_Click()
 
Dim S As String
    Dim oRobo As Object
    Dim txt_OrderNum As String
    Dim txt_Status As String
    Dim txt_Method As String
    Dim txt_Bank_Name As String
    Dim txt_Bank_ABA_Code As String
    Dim txt_Bank_Acct_Num As String
    Dim txt_Amount As Currency
    Dim txt_CheckResponse As String
    Dim txt_CheckResponseReasonCode As String
           
    txt_Bank_Name = [BankName]
    txt_Bank_ABA_Code = [ABARoutingCode]
    txt_Bank_Acct_Num = [AccountNumber]
    txt_Amount = [Total]
    txt_Method = "ECHECK"
    txt_OrderNum = Forms!Orders!OrderID
   
   
    
    ' Create the Robocharge object
    Set oRobo = CreateObject("Robocom.RoboCharge")
    
    ' Initialize Robocharge
    txt_Status = "Initializing Robocharge"
    With CodeContextObject
    .CheckStatus = txt_Status
    End With
    DoEvents
    oRobo.Initialize
    
    ' Set Robocharge Properties
    oRobo.x_Login = ""
    oRobo.x_Password = ""
    ' Login Information removed from above by ModernMatt - 21 Feb 2009
    oRobo.x_Method = txt_Method
    oRobo.x_Amount = txt_Amount
    oRobo.x_Test_Request = False
    oRobo.x_Invoice_Num = txt_OrderNum
    oRobo.x_Bank_Name = txt_Bank_Name
    oRobo.x_Bank_Acct_Num = txt_Bank_Acct_Num
    oRobo.x_Bank_ABA_Code = txt_Bank_ABA_Code
    
    ' This property will enable a log file created by Robocharge
    oRobo.log_file = "C:\Robo.log"
    
   ' Display a status message
    txt_Status = "Processing Check, Please wait . . ."
    With CodeContextObject
    .CheckStatus = txt_Status
    End With
    DoEvents
    
    ' Call Robocharge Process Method
    oRobo.Process
    
    ' Check Robocharge Response Codes and reasons
    If oRobo.x_response_code = "1" Then
        S = "Approved"
          [PaymentType] = 2
    ElseIf oRobo.x_response_code = "2" Then
        S = "Declined"
    ElseIf oRobo.x_response_code = "3" Then
        S = "Error"
    End If
    
    txt_CheckResponse = oRobo.x_response_code + " - " + S
    txt_CheckResponseReasonCode = oRobo.x_response_reason_code
    
    ' Display results
    With CodeContextObject
    .CheckStatus = txt_CheckResponse
    .CheckResponseReasonCode = txt_CheckResponseReasonCode
    End With
 
End Sub
 
 
Private Sub City_AfterUpdate()
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipCity = City
End If
 
End Sub
 
Private Sub CloseButton_Click()
Dim frm As Form
 
Set frm = Forms!Orders
 
frm.Visible = False
 
Set frm = Nothing
 
End Sub
 
Private Sub Command1212_Click()
 
 Dim wrkOrderDeletion As Workspace, strQueryPackages As String, dbsCurrent As Database
 Dim strQueryPackageDetails As String, strQueryOrder As String, intCase As Integer
 Dim strQueryPayments As String
 
On Error GoTo DeletionFailed
 
Set wrkOrderDeletion = DBEngine.Workspaces(0)
Set dbsCurrent = wrkOrderDeletion.Databases(0)
 
 
strQueryPackageDetails = "DELETE FROM PackageDetails WHERE PackageID = " & Forms!Orders![Packages subform]!ID
strQueryPackages = "DELETE FROM Packages WHERE OrderID = " & Me!ID
strQueryOrder = "DELETE FROM Orders WHERE ID = " & Me!ID
strQueryPayments = "DELETE FROM Payments WHERE OrderID = " & "'" & Me!OrderID & "'"
With dbsCurrent
 
.Execute strQueryPackageDetails
.Execute strQueryPackages
.Execute strQueryOrder
.Execute strQueryPayments
 
End With
 
Me.Requery
 
 
MsgBox "Order deletion complete!"
 
Exit Sub
 
DeletionFailed:
    MsgBox Err
    wrkOrderDeletion.Rollback
    Exit Sub
End Sub
 
 
Private Sub Country_AfterUpdate()
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipCountry = Country
End If
 
End Sub
 
 
 
Private Sub Email_AfterUpdate()
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
    Forms!Orders![Packages subform]!ShipPostalCode = PostalCode
Else
    If MsgBox("Would you like to commit this change to the shipping address?", vbYesNoCancel, "Update Orders?") = vbYes Then
        Me!BillingEqualsShipping = -1
        Forms!Orders![Packages subform]!ShipPhone = Phone
        Forms!Orders![Packages subform]!ShipFirstName = FirstName
        Forms!Orders![Packages subform]!ShipLastName = LastName
        Forms!Orders![Packages subform]!ShipAddress = Address
        Forms!Orders![Packages subform]!ShipAddress2 = Address2
        Forms!Orders![Packages subform]!ShipCity = City
        Forms!Orders![Packages subform]!ShipRegion = StateOrProvince
        Forms!Orders![Packages subform]!ShipPostalCode = PostalCode
        Forms!Orders![Packages subform].SetFocus
        Forms!Orders![Packages subform]![PackageDetailsExtended subform].SetFocus
        Forms!Orders![Packages subform]![PackageDetailsExtended subform]!ProductID.SetFocus
    Else
        Forms!Orders![Packages subform].SetFocus
        Forms!Orders![Packages subform]!ShipFirstName.SetFocus
    End If
End If
 
 
End Sub
 
Private Sub FirstName_AfterUpdate()
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipFirstName = FirstName
End If
 
End Sub
Private Sub FirstOrder_Click()
 
 DoCmd.GoToRecord , , acFirst
 
End Sub
 
Private Sub Form_Activate()
 
DoCmd.Maximize
BillTo.Requery
BillTo.SetFocus
 
End Sub
 
Private Sub Form_AfterUpdate()
 
BillTo.Requery
 
End Sub
 
Private Sub Form_Current()
Dim strCouponCredits As String, strCharacter As String, intLength As Integer
Dim strArray() As String, strTemp As String
Dim innerCounter As Integer, outerCounter As Integer, intCouponCount As Integer
Dim strFilter As String
 
If IsNull(Me![PostalCode]) Then
Me!CustomerEdit = 0
Else
Me!CustomerEdit = -1
End If
 
Me![Packages subform]![PackageNumber] = 1
Me![Payment subform]![PaymentNumber] = 1
Me!ShipFromInventory = 0
 
BillTo.Requery
BillTo.SetFocus
 
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
 
If KeyCode = 65 And Shift = 2 Then
 
DoCmd.GoToRecord , , acNewRec
 
End If
 
If KeyCode = 83 And Shift = 2 Then
 
Forms!Orders![Packages subform]!ShipFirstName.SetFocus
 
End If
 
If KeyCode = 71 And Shift = 2 Then
 
On Error GoTo Err_GiftMessageButton_Click
 
    Dim stDocName1 As String
    Dim stLinkCriteria1 As String
 
    stDocName1 = "GiftMessage"
    
    stLinkCriteria1 = "[PackageID]=" & Forms!Orders![Packages subform]![PackageID]
    DoCmd.OpenForm stDocName1, , , stLinkCriteria1
 
Exit_GiftMessageButton_Click:
    Exit Sub
 
Err_GiftMessageButton_Click:
    MsgBox Err.Description
    Resume Exit_GiftMessageButton_Click
 
End If
 
If KeyCode = 84 And Shift = 2 Then
 
On Error GoTo Err_TrackingInfoButton_Click
 
    Dim stDocName2 As String
    Dim stLinkCriteria2 As String
 
    stDocName2 = "Tracking"
    
    stLinkCriteria2 = "[ShipmentID]=" & "'" & Me![ShipmentID] & "'"
    DoCmd.OpenForm stDocName2, , , stLinkCriteria2
 
Exit_TrackingInfoButton_Click:
    Exit Sub
 
Err_TrackingInfoButton_Click:
    MsgBox Err.Description
    Resume Exit_TrackingInfoButton_Click
 
End If
 
End Sub
 
Private Sub Form_Open(Cancel As Integer)
 
DoCmd.Maximize
DoCmd.SetWarnings False
 
End Sub
 
Private Sub LastName_AfterUpdate()
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipLastName = LastName
End If
 
End Sub
 
Private Sub LastOrder_Click()
 
 DoCmd.GoToRecord , , acLast
 
End Sub
 
Private Sub NewOrder_Click()
 
 DoCmd.GoToRecord , , acNewRec
 ShipFromInventory = -1
 
End Sub
 
Private Sub NextOrder_Click()
 
 DoCmd.GoToRecord , , acNext
 
 
End Sub
 
Private Sub OrderDate_Exit(Cancel As Integer)
Dim preOrderDate As Date
Dim postOrderDate As Date
 
preOrderDate = Forms!Orders!OrderDate
postOrderDate = Date
 
If preOrderDate < postOrderDate Then
Forms!Orders!OrderDate = postOrderDate
End If
 
End Sub
 
Private Sub OrderMode_AfterUpdate()
 
If OrderMode = "WWWH" Then
Forms!Orders!PaymentType = "AUTHORIZE.NET"
End If
 
End Sub
 
Private Sub PasteBilling_Click()
Me!BillingEqualsShipping = -1
Forms!Orders![Packages subform]!ShipPhone = Phone
Forms!Orders![Packages subform]!ShipFirstName = FirstName
Forms!Orders![Packages subform]!ShipLastName = LastName
Forms!Orders![Packages subform]!ShipAddress = Address
Forms!Orders![Packages subform]!ShipAddress2 = Address2
Forms!Orders![Packages subform]!ShipCity = City
Forms!Orders![Packages subform]!ShipRegion = StateOrProvince
Forms!Orders![Packages subform]!ShipPostalCode = PostalCode
Forms!Orders![Packages subform].SetFocus
Forms!Orders![Packages subform]![PackageDetailsExtended subform].SetFocus
Forms!Orders![Packages subform]![PackageDetailsExtended subform]!ProductID.SetFocus
End Sub
 
Private Sub PaymentDate_Exit(Cancel As Integer)
Dim preOrderDate As Date
Dim postOrderDate As Date
 
Forms!Orders!PaymentCode = 2
 
preOrderDate = Forms!Orders!OrderDate
postOrderDate = DateAdd("d", 10, Date)
 
If preOrderDate < postOrderDate Then
Forms!Orders!OrderDate = postOrderDate
Forms!Orders![Packages subform]!RequiredDate = DateAdd("d", 11, postOrderDate)
End If
 
End Sub
 
Private Sub PaymentType_AfterUpdate()
Dim preOrderDate As Date
Dim postOrderDate As Date
 
preOrderDate = Forms!Orders!OrderDate
postOrderDate = DateAdd("d", 10, Date)
 
If Forms!Orders!PaymentCode = 2 And preOrderDate < postOrderDate Then
Forms!Orders!OrderDate = postOrderDate
Forms!Orders![Packages subform]!RequiredDate = DateAdd("d", 11, postOrderDate)
End If
 
End Sub
 
Private Sub Phone_AfterUpdate()
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipPhone = Phone
End If
 
 
End Sub
 
Private Sub PostalCode_AfterUpdate()
 
End Sub
 
Private Sub PreviousOrder_Click()
 
 DoCmd.GoToRecord , , acPrevious
 
End Sub
 
Sub PrintInvoice_Click()
On Error GoTo Err_PrintInvoice_Click
Dim strDocName As String
Dim strQueryPayments As String
Dim dbsCurrent As Database
Dim wrkOrderInsert As Workspace
 
   Me![Packages subform].SetFocus
   Me!PrintInvoice.SetFocus
 
If Me!ShipFromInventory Then
    strDocName = "ShipFromInventoryReceipt"
    DoCmd.OpenReport strDocName
Else
    strDocName = "Receipt"
    DoCmd.OpenReport strDocName
End If
        
If [PrintStatus] Then
    MsgBox "Please find and destroy original copy of this receipt!"
End If
 
 PrintStatus.Locked = False
  [PrintStatus] = -1
 PrintStatus.Locked = True
 
'2009-02-04 Ted Palmer
'Jam a payment record into the payments table to satisify a Join in the Sales query
'so that a new Retail Order will appear in the Order List Form. Without this the Retail
'Order will not appear in the Order List Form. Another work-around may be better if this
'application is ever used to keep track of payments.
 
Set wrkOrderInsert = DBEngine.Workspaces(0)
Set dbsCurrent = wrkOrderInsert.Databases(0)
 
strQueryPayments = "INSERT INTO Payments (PaymentType, Payment, PaymentDate, OrderID) VALUES (4,0,Date()," & "'" & Me!OrderID & "')"
 
dbsCurrent.Execute strQueryPayments
 
Exit_PrintInvoice_Click:
    Exit Sub
 
Err_PrintInvoice_Click:
    ' If action was cancelled by the user, don't display an error message.
    Const conErrDoCmdCancelled = 2501
    If (Err = conErrDoCmdCancelled) Then
        Resume Exit_PrintInvoice_Click
    Else
        MsgBox Err.Description
        Resume Exit_PrintInvoice_Click
    End If
 
End Sub
Private Sub Close_Click()
On Error GoTo Err_Close_Click
 
 
    DoCmd.Close
 
Exit_Close_Click:
    Exit Sub
 
Err_Close_Click:
    MsgBox Err.Description
    Resume Exit_Close_Click
    
End Sub
 
Private Sub ProcessCreditCard_Click()
 
Dim S As String
    Dim oRobo As Object
    Dim txt_OrderNum As String
    Dim txt_Status As String
    Dim txt_TransactionType As String
    Dim txt_CardNum As String
    Dim txt_Amount As Currency
    Dim txt_ExpirationDate As String
    Dim lbl_ResponseCode As String
    Dim lbl_ResponseReasonCode As String
    Dim lbl_AVSCode As String
    Dim txt_Zip As String
   
    
    If Not IsNull(CardNum) Then
    txt_CardNum = [CardNum]
    Else
    txt_CardNum = [AMEXNum]
    End If
    txt_ExpirationDate = [ExpDate]
    If [CaptureAmount] = 0 Then
    txt_Amount = [Total]
    Else
    txt_Amount = [CaptureAmount]
    End If
    txt_TransactionType = [TransactionType]
    txt_OrderNum = Forms!Orders!OrderID
    
    If Not IsNull(Forms!Orders!PostalCode) Then
    txt_Zip = Forms!Orders!PostalCode
   End If
    
    ' Create the Robocharge object
    Set oRobo = CreateObject("Robocom.RoboCharge")
    
    ' Initialize Robocharge
    txt_Status = "Initializing Robocharge"
    With CodeContextObject
    .Status = txt_Status
    End With
    DoEvents
    oRobo.Initialize
    
    ' Set Robocharge Properties
    oRobo.x_Login = ""
    oRobo.x_Password = ""
    oRobo.x_Card_Num = txt_CardNum
    oRobo.x_Amount = txt_Amount
    oRobo.x_Exp_Date = txt_ExpirationDate
    oRobo.x_Test_Request = False
    oRobo.x_Invoice_Num = txt_OrderNum
    oRobo.x_Type = txt_TransactionType
    oRobo.x_Zip = txt_Zip
    
    ' This property will enable a log file created by Robocharge
    oRobo.log_file = "C:\Robo.log"
    
   ' Display a status message
    txt_Status = "Processing Credit Card, Please wait . . ."
    With CodeContextObject
    .Status = txt_Status
    End With
    DoEvents
    
    ' Call Robocharge Process Method
    oRobo.Process
    
    ' Check Robocharge Response Codes and reasons
    If oRobo.x_response_code = "1" Then
        S = "Approved"
        [CaptureDate] = Date
        [CaptureAmount] = txt_Amount
        [PaymentCode] = 1
    
    ElseIf oRobo.x_response_code = "2" Then
        S = "Declined"
    ElseIf oRobo.x_response_code = "3" Then
        S = "Error"
    End If
    
    lbl_ResponseCode = oRobo.x_response_code + " - " + S
    lbl_ResponseReasonCode = oRobo.x_response_reason_code
    lbl_AVSCode = oRobo.x_avs_code
    
    ' Display results
    With CodeContextObject
    .Status = lbl_ResponseCode
    .lbl_ResponseReasonCode = lbl_ResponseReasonCode
    .lbl_AVSCode = lbl_AVSCode
    End With
   
End Sub
 
Private Sub TrackingInfoButton_Click()
On Error GoTo Err_TrackingInfoButton_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "Tracking"
    
    stLinkCriteria = "[ShipmentID]=" & "'" & Me![ShipmentID] & "'"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_TrackingInfoButton_Click:
    Exit Sub
 
Err_TrackingInfoButton_Click:
    MsgBox Err.Description
    Resume Exit_TrackingInfoButton_Click
    
End Sub
Private Sub GiftMessageButton_Click()
On Error GoTo Err_GiftMessageButton_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "GiftMessage"
    
    stLinkCriteria = "[PackageID]=" & Me![PackageID]
    DoCmd.OpenForm stDocName, , , stLinkCriteria
    Forms!GiftMessage!GiftMessage.SetFocus
 
Exit_GiftMessageButton_Click:
    Exit Sub
 
Err_GiftMessageButton_Click:
    MsgBox Err.Description
    Resume Exit_GiftMessageButton_Click
    
End Sub
 
Private Sub StateOrProvince_AfterUpdate()
 
 
If ((OrderMode < 7) And StateOrProvince = "MO") Then
Forms!Orders!TaxRate = 0.07225
End If
 
Me!CustomerEdit = -1
If Me!BillingEqualsShipping = -1 Then
Forms!Orders![Packages subform]!ShipRegion = StateOrProvince
End If
 
End Sub
Private Sub FindButton_Click()
On Error GoTo Err_FindButton_Click
 
 
    Screen.PreviousControl.SetFocus
    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
 
Exit_FindButton_Click:
    Exit Sub
 
Err_FindButton_Click:
    MsgBox Err.Description
    Resume Exit_FindButton_Click
    
End Sub
 
 
Private Sub PastePrevious_Click()
On Error GoTo Err_PastePrevious_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "PreviousShippingInfo"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_PastePrevious_Click:
    Exit Sub
 
Err_PastePrevious_Click:
    MsgBox Err.Description
    Resume Exit_PastePrevious_Click
    
End Sub
 
Wholesale event code All:
++++++++++++++++++++++
Option Compare Database  ' Use database order for string comparisons.
Option Explicit  ' Requires variables to be declared before they are used.
 
 
Private Sub BillTo_AfterUpdate()
 
Const conClrWhite = 16777215
Const conNormal = 1
 
'2009-02-18 Ted Palmer
'Commented out. Why? Just because I don't want it to happen.
 
'Forms!WholesaleOrders![Wholesale subform]!ShipFirstName = CompanyName
'Forms!WholesaleOrders![Wholesale subform]!ShipLastName = " - Attn: " & Contact
'Forms!WholesaleOrders![Wholesale subform]!ShipAddress = Address
'Forms!WholesaleOrders![Wholesale subform]!ShipAddress2 = Address2
'Forms!WholesaleOrders![Wholesale subform]!ShipCity = City
'Forms!WholesaleOrders![Wholesale subform]!ShipRegion = StateOrProvince
'Forms!WholesaleOrders![Wholesale subform]!ShipPostalCode = PostalCode
'Forms!WholesaleOrders![Wholesale subform]!ShipPhone = Phone
'Forms!WholesaleOrders![Wholesale subform]!ShipCountry = Country
Contact.Enabled = True
Contact.Locked = False
Contact.BackColor = conClrWhite
Contact.BorderStyle = conNormal
Contact.SetFocus
 
   
    Exit Sub
End Sub
 
Private Sub BillTo_NotInList(NewData As String, Response As Integer)
Dim intNewCustomer As Integer, strTitle As String
Const conClrWhite = 16777215
Const conNormal = 1
 
If (IsNull() Or CustomerID = 0) Then
 
    BillTo.Undo
 
    Phone.Enabled = True
    Phone.Locked = False
    Phone = NewData
 
    Contact.Enabled = True
    Contact.Locked = False
    Contact.BackColor = conClrWhite
    Contact.BorderStyle = conNormal
    Contact.SetFocus
    CompanyName.Enabled = True
    CompanyName.Locked = False
    Address.Enabled = True
    Address.Locked = False
    Address2.Enabled = True
    Address2.Locked = False
    City.Enabled = True
    City.Locked = False
    StateOrProvince.Enabled = True
    StateOrProvince.Locked = False
    PostalCode.Enabled = True
    PostalCode.Locked = False
    Country.Enabled = True
    Country.Locked = False
    Email.Enabled = True
    Email.Locked = False
    ShipNotification.Enabled = True
    ShipNotification.Locked = False
 
    Response = acDataErrContinue
 
End If
 
End Sub
 
Private Sub CloseButton_Click()
Dim frm As Form
 
Set frm = Forms!WholesaleOrders
 
frm.Visible = False
 
Set frm = Nothing
 
End Sub
 
Private Sub Command860_Click()
Dim wrkOrderDeletion As Workspace, strQueryPackages As String, dbsCurrent As Database
Dim strQueryPackageDetails As String, strQueryOrder As String, intCase As Integer
 
On Error GoTo DeletionFailed
 
Set wrkOrderDeletion = DBEngine.Workspaces(0)
Set dbsCurrent = wrkOrderDeletion.Databases(0)
 
strQueryPackageDetails = "DELETE FROM WholesalePackageDetails WHERE PackageID = " & Forms!WholesaleOrders![Wholesale subform]!ID
strQueryPackages = "DELETE FROM WholesalePackages WHERE OrderID = " & Me!ID
strQueryOrder = "DELETE FROM [Wholesale Orders] WHERE ID = " & Me!ID
 
With dbsCurrent
 
.Execute strQueryPackageDetails
.Execute strQueryPackages
.Execute strQueryOrder
 
End With
 
Me.Requery
 
 
MsgBox "Order deletion complete!"
 
Exit Sub
 
DeletionFailed:
    MsgBox Err
    wrkOrderDeletion.Rollback
    Exit Sub
End Sub
 
Private Sub Email_Exit(Cancel As Integer)
'2009-02-18 Ted Palmer
'Cloned from Retail [Orders] form.
    If MsgBox("Would you like to commit this change to the shipping address?", vbYesNoCancel, "Update Orders?") = vbYes Then
        Me!BillingEqualsShipping = -1
        Forms!WholesaleOrders![Wholesale subform]!ShipPhone = Phone
        Forms!WholesaleOrders![Wholesale subform]!ShipFirstName = CompanyName
        Forms!WholesaleOrders![Wholesale subform]!ShipLastName = " - Attn: " & Contact
        Forms!WholesaleOrders![Wholesale subform]!ShipAddress = Address
        Forms!WholesaleOrders![Wholesale subform]!ShipAddress2 = Address2
        Forms!WholesaleOrders![Wholesale subform]!ShipCity = City
        Forms!WholesaleOrders![Wholesale subform]!ShipRegion = StateOrProvince
        Forms!WholesaleOrders![Wholesale subform]!ShipPostalCode = PostalCode
        Forms!WholesaleOrders![Wholesale subform].SetFocus
        'Forms!WholesaleOrders![Wholesale subform]![PackageDetailsExtended subform].SetFocus
        'Forms!WholesaleOrders![Wholesale subform]![PackageDetailsExtended subform]!ProductID.SetFocus
    Else
        Forms!WholesaleOrders![Wholesale subform].SetFocus
        Forms!WholesaleOrders![Wholesale subform]!ShipFirstName.SetFocus
    End If
 
End Sub 'Email_Exit
 
Private Sub FirstOrder_Click()
 
DoCmd.GoToRecord , , acFirst
 
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 65 And Shift = 2 Then
 
DoCmd.GoToRecord , , acNewRec
 
End If
 
If KeyCode = 83 And Shift = 2 Then
 
Forms!WholesaleOrders![Wholesale subform]!ShipFirstName.SetFocus
 
End If
 
If KeyCode = 71 And Shift = 2 Then
 
On Error GoTo Err_GiftMessageButton_Click
 
    Dim stDocName1 As String
    Dim stLinkCriteria1 As String
 
    stDocName1 = "GiftMessage"
    
    'stLinkCriteria1 = "[PackageID]=" & Forms!WholesaleOrders![WholesaleDetailsExtended subform]![PackageID]
    'DoCmd.OpenForm stDocName1, , , stLinkCriteria1
 
Exit_GiftMessageButton_Click:
    Exit Sub
 
Err_GiftMessageButton_Click:
    MsgBox Err.Description
    Resume Exit_GiftMessageButton_Click
 
End If
 
If KeyCode = 84 And Shift = 2 Then
 
On Error GoTo Err_TrackingInfoButton_Click
 
    Dim stDocName2 As String
    Dim stLinkCriteria2 As String
 
    stDocName2 = "Tracking"
    
    'stLinkCriteria2 = "[ShipmentID]=" & "'" & Me![ShipmentID] & "'"
    'DoCmd.OpenForm stDocName2, , , stLinkCriteria2
 
Exit_TrackingInfoButton_Click:
    Exit Sub
 
Err_TrackingInfoButton_Click:
    MsgBox Err.Description
    Resume Exit_TrackingInfoButton_Click
 
End If
 
End Sub
 
Private Sub LastOrder_Click()
 
DoCmd.GoToRecord , , acLast
 
End Sub
Private Sub NextOrder_Click()
 
DoCmd.GoToRecord , , acNext
 
End Sub
Private Sub PreviousOrder_Click()
 
DoCmd.GoToRecord , , acPrevious
 
End Sub
Private Sub NewOrder_Click()
 
DoCmd.GoToRecord , , acNewRec
 
End Sub
Private Sub Form_Activate()
 
DoCmd.Maximize
 
End Sub
 
Private Sub Form_AfterUpdate()
 
'BillTo.Requery
 
End Sub
Private Sub Form_Current()
 
Forms!WholesaleOrders![Wholesale subform]!PackageNumber = 1
 
BillTo.SetFocus
 
End Sub
 
 
Private Sub Form_Open(Cancel As Integer)
 
DoCmd.Maximize
 
End Sub
 
Private Sub PastePrevious_Click()
On Error GoTo Err_PastePrevious_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "WholesalePreviousShippingInfo"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_PastePrevious_Click:
    Exit Sub
 
Err_PastePrevious_Click:
    MsgBox Err.Description
    Resume Exit_PastePrevious_Click
    
End Sub
 
Sub PrintInvoice_Click()
On Error GoTo Err_PrintInvoice_Click
 
    Dim strDocName As String
  
    strDocName = "Invoice"
        
    Me![Wholesale subform].SetFocus
    Me!PrintInvoice.SetFocus
            
    ' Print Invoice report, using Invoices Filter query to print
    ' invoice for current order.
    DoCmd.OpenReport strDocName, acViewNormal, "Invoices Filter"
    [PrintStatus] = -1
        
Exit_PrintInvoice_Click:
    Exit Sub
 
Err_PrintInvoice_Click:
    ' If action was cancelled by the user, don't display an error message.
    Const conErrDoCmdCancelled = 2501
    If (Err = conErrDoCmdCancelled) Then
        Resume Exit_PrintInvoice_Click
    Else
        MsgBox Err.Description
        Resume Exit_PrintInvoice_Click
    End If
 
End Sub
Private Sub Close_Click()
On Error GoTo Err_Close_Click
 
 
    DoCmd.Close
 
Exit_Close_Click:
    Exit Sub
 
Err_Close_Click:
    MsgBox Err.Description
    Resume Exit_Close_Click
    
End Sub
 
 
Private Sub StateOrProvince_AfterUpdate()
 
'Forms!Orders![WholesalePackages subform]!ReadyToShip = -1
 
End Sub
Private Sub FindButton_Click()
On Error GoTo Err_FindButton_Click
 
 
    Screen.PreviousControl.SetFocus
    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
 
Exit_FindButton_Click:
    Exit Sub
 
Err_FindButton_Click:
    MsgBox Err.Description
    Resume Exit_FindButton_Click
    
End Sub

Open in new window

0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Here's the Current event of one of your forms. Try commenting out the Billto.Requery and see what happens:

Private Sub Form_Current()
Dim strCouponCredits As String, strCharacter As String, intLength As Integer
Dim strArray() As String, strTemp As String
Dim innerCounter As Integer, outerCounter As Integer, intCouponCount As Integer
Dim strFilter As String
 
If IsNull(Me![PostalCode]) Then
Me!CustomerEdit = 0
Else
Me!CustomerEdit = -1
End If
 
Me![Packages subform]![PackageNumber] = 1
Me![Payment subform]![PaymentNumber] = 1
Me!ShipFromInventory = 0
'/commented out
'/BillTo.Requery
BillTo.SetFocus
 
End Sub
0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
LSMConsulting,

That script is in the "On Current" event of the Retail Order form just named "Orders" which is not having any behavior problems right now. So there should be no need for any changes there. The form that is giving me behavior problems is "WholesaleOrders".

Thank you,

Ted Palmer
0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
LSMConsulting,

On the WholesaleOrders form I added a statement near the beginning of the script shown below

Private Sub BillTo_NotInList(NewData As String, Response As Integer)
Dim intNewCustomer As Integer, strTitle As String
Const conClrWhite = 16777215
Const conNormal = 1

'Added statement
DoCmd.GoToRecord , , acNewRec

It didn't help. "Billto" control selects the table record the form should be updating.
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Just notice too in your code you have user pass info for something named "RoboCharge" .. you should alert the mods and have them remove that immediately (use the Request Attention feature).
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
GoToRecord would force the FORM to go to a New record ...

Your said: <I have analyzed all the event scripts for each of the Customer Contact Information text boxes>

What are the NAMES of these textboxes? I don't see them in the code module you uploaded ... I see BillTo, Email, etc but nothing that looks like a CustomerContact textbox. Are you working with Subforms? If so, are these on the subform? If they are, we'd need to see the code module behind those forms as well.

Can you upload this database? You can strip out all the sensitive data and use the Attach File link below to do this.

0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
That RoboCharge stuff hasn't been used in years. It should be a dead account. I forgot about that being in there. I should do something about it though and not just assume that it is a dead account. My client acquired this business in about year 2002 and I know that he doesn't use it. I do something about it when we finish here.

I couldn't possible upload the database files (FrontEnd and BackEnd). It would be impossible for me to clear out the customer data -- About 44,000 orders since year 2001.

I just realized that because the database is split into a FrontEnd and BackEnd, I could upload the Front End without there being any customer data.  I still don't feel OK with uploading software that doesn't belong to me. The software is pretty convoluted so it would be of marginal value to anybody that wanted to use it but still it isn't mine.

I'm attaching the code for the 2 sub forms in different comments to make it easier to identify each one. The first one is attached to this comment. I'll add another comment with the other.
SubForm named "Wholesale subform"
++++++++++++++++++++++++++++++++
 
Option Compare Database
Option Explicit
Private Sub DeletePackageButton_Click()
    Dim wrkPackageDeletion As Workspace, dbsCurrent As Database, strQueryPackages As String
    Dim strQueryPackageDetails As String, intPackageCount As Integer
    Dim intZone As Integer
    Dim strWeight As String
    Dim intPackageWeight As Integer
    Dim strRegion As String
    Dim intCarrier As Integer
    Dim strDelivery As String
    Dim strZone As String
    Dim curPackageFreight As Currency
    Dim curPackageTax As Currency
    Dim strOrderID As String
 
On Error GoTo DeletionFailed
 
intPackageCount = [PackageCount]
 
Set wrkPackageDeletion = DBEngine.Workspaces(0)
Set dbsCurrent = wrkPackageDeletion.Databases(0)
 
strQueryPackages = "DELETE FROM WholesalePackages WHERE ID =" & Me!ID
strQueryPackageDetails = "DELETE FROM WholesalePackageDetails WHERE PackageID =" & Me!ID
 
wrkPackageDeletion.BeginTrans
 
With dbsCurrent
    .Execute strQueryPackageDetails
    .Execute strQueryPackages
End With
 
wrkPackageDeletion.CommitTrans
 
Me.Requery
 
If intPackageCount = 1 Then
 
[PackageCount] = 1
[PackageNumber] = 1
 
Forms!WholesaleOrders![Wholesale subform]!Residential = -1
Forms!WholesaleOrders![Wholesale subform]!ShipFirstName = Forms!WholesaleOrders!Contact
Forms!WholesaleOrders![Wholesale subform]!ShipLastName = Forms!WholesaleOrders!LastName
Forms!WholesaleOrders![Wholesale subform]!ShipAddress = Forms!WholesaleOrders!Address
Forms!WholesaleOrders![Wholesale subform]!ShipAddress2 = Forms!WholesaleOrders!Address2
Forms!WholesaleOrders![Wholesale subform]!ShipCity = Forms!WholesaleOrders!City
Forms!WholesaleOrders![Wholesale subform]!ShipRegion = Forms!WholesaleOrders!StateOrProvince
Forms!WholesaleOrders![Wholesale subform]!ShipPostalCode = Forms!WholesaleOrders!PostalCode
Forms!WholesaleOrders![Wholesale subform]!ShipPhone = Forms!WholesaleOrders!Phone
Forms!WholesaleOrders![Wholesale subform]!ShipCountry = Forms!WholesaleOrders!Country
 
Forms!WholesaleOrders!OrderSubtotal = 0
Forms!WholesaleOrders!TotalFreight = 0
 
Else
 
[PackageNumber] = [PackageNumber] - 1
 
 
'Begin Recalculation of Order Subtotal and Freight
 
 
 
'End Recalculation of Order Subtotal and Freight
 
End If
 
 
Forms!WholesaleOrders![Wholesale subform].SetFocus
Forms!WholesaleOrders![Wholesale subform]![WholesaleDetailsExtended subform].SetFocus
DoCmd.GoToRecord , , acNewRec
Forms!WholesaleOrders![Wholesale subform]![WholesaleDetailsExtended subform]!ProductID.SetFocus
 
 
MsgBox "Deletion of Package Complete."
 
Exit Sub
 
DeletionFailed:
    MsgBox Err
    wrkPackageDeletion.Rollback
    Exit Sub
 
End Sub
 
Private Sub Form_Current()
Dim strTemp As String
 
If Not IsNull(Forms!WholesaleOrders!ID) Then
strTemp = "ID = " & Forms!WholesaleOrders!ID
[PackageCount] = DLookup("[CountOfPackageID]", "[NumberOfWholesalePackages]", strTemp)
Else
[PackageCount] = 1
End If
 
End Sub
 
Private Sub GiftMsgButton_Click()
On Error GoTo Err_GiftMsgButton_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
    
    stDocName = "WholesaleGiftMessage"
    
    stLinkCriteria = "[ID]=" & Me![ID]
    DoCmd.OpenForm stDocName, , , stLinkCriteria
    Forms!WholesaleGiftMessage!GiftMessage.SetFocus
 
Exit_GiftMsgButton_Click:
    Exit Sub
 
Err_GiftMsgButton_Click:
    MsgBox Err.Description
    Resume Exit_GiftMsgButton_Click
    
End Sub
 
    
Private Sub Residential_Click()
 
If (Residential = 0 And Forms!WholesaleOrders!TotalFreight <> 0) Then
Me!Freight = Me!Freight - 0
Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders!TotalFreight - 0
Else
If Forms!WholesaleOrders!TotalFreight <> 0 Then
Me!Freight = Me!Freight + 0
Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders!TotalFreight + 0
End If
End If
 
 
End Sub
 
Private Sub ShipAddress_AfterUpdate()
 
Residential = CompareBillingAndShipping()
 
End Sub
 
Private Sub ShipAddress2_AfterUpdate()
 
Residential = CompareBillingAndShipping()
 
End Sub
 
Private Sub ShipCity_AfterUpdate()
 
Residential = CompareBillingAndShipping()
 
End Sub
 
Private Sub ShipFirstName_AfterUpdate()
 
Residential = CompareBillingAndShipping()
 
End Sub
 
Private Sub ShipPhone_AfterUpdate()
 
Residential = CompareBillingAndShipping()
 
End Sub
 
Private Sub ShipPostalCode_AfterUpdate()
 
Residential = CompareBillingAndShipping()
 
End Sub
 
Private Sub ShipRegion_AfterUpdate()
 
Residential = CompareBillingAndShipping()
 
End Sub
 
Private Sub SpecialColorsButton_Click()
On Error GoTo Err_SpecialColorsButton_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "WholesaleSpecialColors"
    
    stLinkCriteria = "[PackageID]=" & Me![ID]
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_SpecialColorsButton_Click:
    Exit Sub
 
Err_SpecialColorsButton_Click:
    MsgBox Err.Description
    Resume Exit_SpecialColorsButton_Click
    
 
End Sub
 
Private Sub TrackingButton_Click()
On Error GoTo Err_TrackingButton_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "Tracking"
    
    stLinkCriteria = "[ShipmentID]=" & "'" & Me![ShipmentID] & "'"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_TrackingButton_Click:
    Exit Sub
 
Err_TrackingButton_Click:
    MsgBox Err.Description
    Resume Exit_TrackingButton_Click
    
End Sub
Private Sub Command61_Click()
On Error GoTo Err_Command61_Click
 
 
DoCmd.GoToRecord , , acNewRec
 
[PackageCount] = [PackageCount] + 1
[PackageNumber] = [PackageCount]
 
Forms!WholesaleOrders![Wholesale subform]!RequiredDate = DateAdd("d", 14, Forms!WholesaleOrders!OrderDate)
 
Forms!WholesaleOrders![Wholesale subform]!ShipFirstName = Forms!WholesaleOrders!Contact
Forms!WholesaleOrders![Wholesale subform]!ShipLastName = Forms!WholesaleOrders!LastName
Forms!WholesaleOrders![Wholesale subform]!ShipAddress = Forms!WholesaleOrders!Address
Forms!WholesaleOrders![Wholesale subform]!ShipAddress2 = Forms!WholesaleOrders!Address2
Forms!WholesaleOrders![Wholesale subform]!ShipCity = Forms!WholesaleOrders!City
Forms!WholesaleOrders![Wholesale subform]!ShipRegion = Forms!WholesaleOrders!StateOrProvince
Forms!WholesaleOrders![Wholesale subform]!ShipPostalCode = Forms!WholesaleOrders!PostalCode
Forms!WholesaleOrders![Wholesale subform]!ShipPhone = Forms!WholesaleOrders!Phone
Forms!WholesaleOrders![Wholesale subform]!ShipCountry = Forms!WholesaleOrders!Country
 
Forms!WholesaleOrders![Wholesale subform].SetFocus
Forms!WholesaleOrders![Wholesale subform]![WholesaleDetailsExtended subform].SetFocus
DoCmd.GoToRecord , , acNewRec
Forms!WholesaleOrders![Wholesale subform]![WholesaleDetailsExtended subform]!ProductID.SetFocus
 
Exit_Command61_Click:
    Exit Sub
 
Err_Command61_Click:
    MsgBox Err.Description
    Resume Exit_Command61_Click
    
End Sub
Private Sub Command63_Click()
On Error GoTo Err_Command63_Click
 
 
    DoCmd.GoToRecord , , acFirst
    [PackageNumber] = 1
 
Exit_Command63_Click:
    Exit Sub
 
Err_Command63_Click:
    MsgBox Err.Description
    Resume Exit_Command63_Click
    
End Sub
Private Sub Command64_Click()
On Error GoTo Err_Command64_Click
 
 
     DoCmd.GoToRecord , , acLast
    PackageNumber = PackageCount
 
Exit_Command64_Click:
    Exit Sub
 
Err_Command64_Click:
    MsgBox Err.Description
    Resume Exit_Command64_Click
    
End Sub
Private Sub Command65_Click()
On Error GoTo Err_Command65_Click
 
If PackageNumber < PackageCount Then
    DoCmd.GoToRecord , , acNext
    PackageNumber = PackageNumber + 1
Else
    MsgBox "You are at the end of the recordset!" & Chr(13) & "Please use the new package button instead."
End If
 
Exit_Command65_Click:
    Exit Sub
 
Err_Command65_Click:
    MsgBox Err.Description
    Resume Exit_Command65_Click
    
End Sub
Private Sub Command66_Click()
On Error GoTo Err_Command66_Click
    
    DoCmd.GoToRecord , , acPrevious
    PackageNumber = PackageNumber - 1
 
Exit_Command66_Click:
    Exit Sub
 
Err_Command66_Click:
    MsgBox Err.Description
    Resume Exit_Command66_Click
    
End Sub
 
Function CompareBillingAndShipping()
 
If Forms!WholesaleOrders!Phone = Me!ShipPhone And Forms!WholesaleOrders!CompanyName = Me!ShipFirstName And Forms!WholesaleOrders!Address = Me!ShipAddress And Forms!WholesaleOrders!City = Me!ShipCity And Forms!WholesaleOrders!StateOrProvince = Me!ShipRegion And Forms!WholesaleOrders!PostalCode = Me!ShipPostalCode Then
    CompareBillingAndShipping = 0
    If Forms!WholesaleOrders!TotalFreight <> 0 And Me!Residential = -1 Then
        Me!Freight = Me!Freight - 0
        Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders!TotalFreight - 0
    End If
    Forms!WholesaleOrders!BillingEqualsShipping = -1
 Else
    CompareBillingAndShipping = -1
    If Forms!WholesaleOrders!TotalFreight <> 0 And Me!Residential = 0 Then
        Me!Freight = Me!Freight + 0
        Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders!TotalFreight + 0
    End If
    Forms!WholesaleOrders!BillingEqualsShipping = 0
End If
 
End Function

Open in new window

0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
Here is the code behind the other sub form.
WholesaleDetailsExtended subform
++++++++++++++++++++++++++++++++
 
Option Compare Database
Option Explicit
 
Private Sub Form_AfterDelConfirm(Status As Integer)
 
    Dim intZone, intPackageWeight, intCarrier As Integer
    Dim strWeight, strRegion, strDelivery, strOrderID, strPackageID As String
    Dim curPackageFreight, curPackageSubtotal As Currency
   
    strOrderID = "ID = " & Me!ThisOrderID
    If Not IsNull(DLookup("[ExtendedPrice]", "[WholesaleOrderSubtotal]", strOrderID)) Then
        Forms!WholesaleOrders!OrderSubtotal = DLookup("[ExtendedPrice]", "[WholesaleOrderSubtotal]", strOrderID)
    End If
    
    strOrderID = "OrderID = " & Me!ThisOrderID
    If Not IsNull(DLookup("[SumOfFreight]", "[WholesaleOrderFreight]", strOrderID)) Then
       curPackageFreight = DLookup("[SumOfFreight]", "[WholesaleOrderFreight]", strOrderID)
    Else
       curPackageFreight = 0
    End If
    
    strPackageID = "ID = " & Forms!WholesaleOrders![Wholesale subform]![ID]
    If Not IsNull(DLookup("[ExtendedPrice]", "[WholesalePackage Subtotal]", strPackageID)) Then
    curPackageSubtotal = DLookup("[ExtendedPrice]", "[WholesalePackage Subtotal]", strPackageID)
    Else
        curPackageSubtotal = 0
    End If
    
      If [PackageSubtotal] >= 100 Then
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValue] = -1
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValueAmount] = curPackageSubtotal
    Else
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValue] = 0
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValueAmount] = 0
    End If
                   
    
    strRegion = "StateOrProvince = '" & Forms!WholesaleOrders![Wholesale subform]![ShipRegion] & "'"
    intCarrier = Forms!WholesaleOrders![Wholesale subform]!ShipMethod
    strDelivery = Forms!WholesaleOrders![Wholesale subform]!DeliveryMethod
    intZone = DLookup("Zone", "WholesaleShippingZones", strRegion)
    
    If Not IsNull(DLookup("[PackageWeight]", "[WholesalePackageWeight]", "[PackageID]=[PackageID]")) Then
    intPackageWeight = DLookup("[PackageWeight]", "[WholesalePackageWeight]", "[PackageID]=[PackageID]")
    Else
    intPackageWeight = 0
    End If
    
    strWeight = "Weight = '" & intPackageWeight & "'"
     
     If strDelivery = "GROUND" Then
      Select Case intZone
      Case 1
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[1]", "WholesaleShippingRates", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 2
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[2]", "WholesaleShippingRates", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 3
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[3]", "WholesaleShippingRates", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      End Select
     End If
   
     If strDelivery = "3 DAY SELECT" Then
      Select Case intZone
      Case 1
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[1]", "3daySelect", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 2
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[2]", "3daySelect", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 3
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[3]", "3daySelect", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      End Select
     End If
   
     If strDelivery = "PRIORITY" Then
      Forms!WholesaleOrders![Wholesale subform]!Freight = 3.75
     End If
 
 
End Sub
 
Private Sub Form_AfterUpdate()
    Dim intZone, intPackageWeight, intCarrier As Integer
    Dim strOrderID, strPackageID, strWeight, strRegion, strDelivery, strZone As String
    Dim curPackageFreight, curPackageSubtotal, curResidential As Currency
    Dim intQuantity, intProductID, intLength, intCounter, intSpaceCount As Integer
    Dim strDescription, strCharacter, strTemp As String
    
intProductID = Me!ProductID
strDescription = Me![Description]
intLength = Len(strDescription)
    
 
If IsNull(strDescription) And intProductID < 400 Then
        MsgBox "Please enter a description or change product" & Chr(13) & "selection to a non-personalized item."
        ProductID.SetFocus
        Description.SetFocus
        Exit Sub
End If
    
   If (intProductID < 400) Then
   
    If intLength < 14 Then
    
    intCounter = 0
    intSpaceCount = 0
 
    While intCounter < intLength
        intCounter = intCounter + 1
        strCharacter = Mid(strDescription, intCounter, 1)
    
        If (strCharacter = " ") Then
        intSpaceCount = intSpaceCount + 1
        End If
    
    Wend
    
      If (intSpaceCount > 0) Then
        
        If (intSpaceCount > 1) Then
        
        MsgBox "You have entered too many spaces." & Chr(13) & "Please remove all extra spaces from" & Chr(13) & "the description for this item."
        ProductID.SetFocus
        Description.SetFocus
        Exit Sub
        
        Else
            
            If (intProductID <> 103 And intProductID <> 112 And intProductID <> 203 And intProductID <> 210 And intProductID <> 307 And intProductID <> 311) Then
            MsgBox "You have entered a description with a space." & Chr(13) & "Please change to a double name product or remove the space."
           
            ProductID.SetFocus
            Exit Sub
            
            Else
                If (intLength - intSpaceCount) > 11 Then
                MsgBox "Double Name Products may only have a total of 11 letters." & Chr(13) & "Please reduce the number of letters in the description."
                ProductID.SetFocus
                Description.SetFocus
                Exit Sub
                End If
            End If
        
        End If
    
      Else
        
        If (intProductID <> 102 And intProductID <> 111 And intProductID <> 202 And intProductID <> 206 And intProductID <> 207 And intProductID <> 209 And intProductID <> 213 And intProductID <> 306 And intProductID <> 310 And intLength > 8) Then
          MsgBox "You have entered more than 8 letters for a standard sized product." & Chr(13) & "Please reduce the number of letters in the description or switch to the longer sized product."
          
          ProductID.SetFocus
          Exit Sub
        End If
    
      End If
    
    Else
    
    MsgBox "You have entered more than 13 characters. " & Chr(13) & "Please re-enter the description."
    ProductID.SetFocus
    Description.SetFocus
    Exit Sub
    End If
 
End If
    strOrderID = "OrderID = '" & Me!ThisOrderID & "'"
    If Not IsNull(DLookup("[ExtendedPrice]", "[WholesaleOrderSubtotal]", strOrderID)) Then
        Forms!WholesaleOrders!OrderSubtotal = DLookup("[ExtendedPrice]", "[WholesaleOrderSubtotal]", strOrderID)
    End If
    
    strOrderID = "OrderID = '" & Me!ThisOrderID & "'"
    If Not IsNull(DLookup("[SumOfFreight]", "[WholesaleOrderFreight]", strOrderID)) Then
       curPackageFreight = DLookup("[SumOfFreight]", "[WholesaleOrderFreight]", strOrderID)
    Else
       curPackageFreight = 0
    End If
    
    If (Forms!WholesaleOrders![Wholesale subform]![Residential] = 0) Then
            curResidential = 0
    Else
            curResidential = 0
    End If
    
    strPackageID = "ID = " & Forms!WholesaleOrders![Wholesale subform]![ID]
    If Not IsNull(DLookup("[ExtendedPrice]", "[WholesalePackage Subtotal]", strPackageID)) Then
    curPackageSubtotal = DLookup("[ExtendedPrice]", "[WholesalePackage Subtotal]", strPackageID)
    Else
        curPackageSubtotal = 0
    End If
    
      If [PackageSubtotal] >= 100 Then
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValue] = -1
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValueAmount] = curPackageSubtotal
    Else
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValue] = 0
    Forms!WholesaleOrders![Wholesale subform]![DeclaredValueAmount] = 0
    End If
                   
    
    strRegion = "StateOrProvince = '" & Forms!WholesaleOrders![Wholesale subform]![ShipRegion] & "'"
    intCarrier = Forms!WholesaleOrders![Wholesale subform]!ShipMethod
    strDelivery = Forms!WholesaleOrders![Wholesale subform]!DeliveryMethod
    intZone = DLookup("Zone", "WholesaleShippingZones", strRegion)
    
    If Not IsNull(DLookup("[PackageWeight]", "[WholesalePackageWeight]", "[PackageID]=[PackageID]")) Then
    intPackageWeight = DLookup("[PackageWeight]", "[WholesalePackageWeight]", "[PackageID]=[PackageID]")
    Else
    intPackageWeight = 0
    End If
    
    strWeight = "Weight = '" & intPackageWeight & "'"
     
     If strDelivery = "GROUND" Then
      Select Case intZone
      Case 1
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[1]", "WholesaleShippingRates", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 2
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[2]", "WholesaleShippingRates", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 3
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[3]", "WholesaleShippingRates", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      End Select
     End If
   
     If strDelivery = "3 DAY SELECT" Then
      Select Case intZone
      Case 1
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[1]", "3daySelect", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 2
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[2]", "3daySelect", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      Case 3
      Forms!WholesaleOrders![Wholesale subform]!Freight = DLookup("[3]", "3daySelect", strWeight)
      Forms!WholesaleOrders!TotalFreight = Forms!WholesaleOrders![Wholesale subform]!Freight + curPackageFreight
      End Select
     End If
   
     If strDelivery = "PRIORITY" Then
      Forms!WholesaleOrders![Wholesale subform]!Freight = 3.75
     End If
 
End Sub
 
Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim dbsHW As Database
    Dim rstInventory As Recordset
    Dim intQuantity, intProductID, intLength, intCounter, intSpaceCount As Integer
    Dim strDescription, strCharacter, strTemp, strColors As String
    
intProductID = Me!ProductID
strDescription = Me![Description]
 
If (intProductID < 400 And Me!Router = 0) Then
    Set dbsHW = CurrentDb
    strTemp = "SELECT Inventory.ProductID, Inventory.Quantity, Inventory.Description, Inventory.Pastels FROM Inventory WHERE (((Inventory.Description)= '" & strDescription & "')) ORDER BY Inventory.ProductID;"
    Set rstInventory = CurrentDb.OpenRecordset(strTemp)
    rstInventory.FindFirst "ProductID = " & intProductID & " And Pastels = " & Me!Pastels
    If rstInventory.NoMatch Then
        rstInventory.Close
        Set rstInventory = Nothing
        Set dbsHW = Nothing
        Exit Sub
    End If
    intQuantity = rstInventory!Quantity
    If Me!Pastels Then
        strColors = "Pastel"
    Else
        strColors = "Primary"
    End If
    strTemp = "There is(are) " & intQuantity & " " & strDescription & " " & DLookup("[ProductName]", "[Products]", "ProductID = " & intProductID) & "(s) in " & strColors & " colors in inventory.  Do you want to pull this order item from inventory?"
    If intQuantity > 0 Then
    If MsgBox(strTemp, vbOKCancel) = 1 Then
    rstInventory.Edit
    rstInventory!Quantity = rstInventory!Quantity - 1
    rstInventory.Update
    Me!Instructions = "Ship from Inventory"
    Me!Router = -1
    End If
    End If
    rstInventory.Close
    Set rstInventory = Nothing
    Set dbsHW = Nothing
End If
            
If (intProductID > 400) Then
         strTemp = "[ProductID] = " & Me!ProductID
         Me!Description = DLookup("[ProductName]", "[WholesaleProducts]", strTemp)
End If
 
End Sub
 
Private Sub Form_Current()
 
 
ProductID.SetFocus
 
End Sub
 
Private Sub Form_Delete(Cancel As Integer)
Dim dbsHW As Database
Dim rstInventory As Recordset
Dim intProductID As Integer
Dim strDescription, strTemp As String
 
intProductID = Me!ProductID
strDescription = Me![Description]
          
If (intProductID < 400 And Me!Instructions = "Ship from Inventory") Then
    Set dbsHW = CurrentDb
    strTemp = "SELECT Inventory.ProductID, Inventory.Quantity, Inventory.Description, Inventory.Pastels FROM Inventory WHERE (((Inventory.Description)= '" & strDescription & "')) ORDER BY Inventory.ProductID;"
    Set rstInventory = CurrentDb.OpenRecordset(strTemp)
    rstInventory.FindFirst "ProductID = " & intProductID & " And Pastels = " & Me!Pastels
    
    If Not rstInventory.NoMatch Then
       
        rstInventory.Edit
        rstInventory!Quantity = rstInventory!Quantity + 1
        rstInventory.Update
       
    End If
        rstInventory.Close
        Set rstInventory = Nothing
        Set dbsHW = Nothing
    
     Me!ProductID = 800
 
     Me!Description = " "
     Me!Pastels = 0
     Me!Instructions = " "
     Me!Router = 0
       
End If
 
End Sub
 
Private Sub G_Click()
 
 Dim stDocName As String
 Dim stLinkCriteria As String
 
If (G = -1) Then
 
stDocName = "WholesaleGiftMessage"
stLinkCriteria = "[ID]=" & Me![ID]
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Forms!WholesaleGiftMessage!GiftMessage.SetFocus
 
End If
End Sub
 
Private Sub ProductID_AfterUpdate()
 
Dim strFilter As String
    
    ' Evaluate filter before it's passed to DLookup function.
    strFilter = "ProductID = " & Me!ProductID
    
    ' Look up product's unit price and assign it to UnitPrice control.
    Me!UnitPrice = DLookup("UnitPrice", "WholesaleProducts", strFilter)
 
Exit_ProductID_AfterUpdate:
    Exit Sub
 
Err_ProductID_AfterUpdate:
    MsgBox Err.Description
    Resume Exit_ProductID_AfterUpdate
 
End Sub
 
 
Private Sub S_Click()
Dim stDocName As String
Dim stLinkCriteria As String
 
If (ApplySpecialColors = -1) Then
 
stDocName = "WholesaleSpecialColors"
stLinkCriteria = "[ID]=" & Me![ID]
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
DoCmd.OpenForm stDocName, , , stLinkCriteria
 
End If
End Sub

Open in new window

0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
The Customer contact information textboxes are on the form WholesaleOrders not on a sub form. I don't believe you will see them represented in the script event code unless there is code for an event on that TextBox. Only one or two of the textboxes has any script at all, and the script make no reference to changing the current record.
0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
Thank you for your suggestion about the break points. I am going to try it today. It sounds like a labor intensive time consuming process so I better get started so I'll have some time left to do some chores that I must do today. I posted a question for the "Mods" about removing the UID and PW for the . . . .

I hope you don't mind if I keep this question open while I follow your suggestion. I would really like to discover a fix for this bad behavior.

Thank you,
Ted Palmer
0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
LSMConsulting,

I did as you suggested by putting breakpoints on the first line of executable code in every event script on the offending form. I decided the code is too convoluted to follow, but I was surprised by what I learned before deciding that I might not live long enough to figure this out. My client didn't ask for that fix any way. He is still content with using the IDE to enter new Wholesale customers, but I was not. And I was too stubbourn to give up without burning up a whole bunch of nonbillable time.

Oh! ModernMatt the moderator edited out the UID and PW you spotted in the code snipped. I'll look mush closer in the future before I upload script from a clinet's application seeking help.

Thank you for your help.

TedPalmer
0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
THANK YOU..!!

TedPalmer
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Did you get this fixed? Just curious - if so, what did it turn out to be?
0
 
Ted PalmerInformation Technology ConsultantAuthor Commented:
LSMConsulting,

No I didn't get it fixed. I have spent way too much time in this already. One of the things the original author did was open about 5 forms on startup then he hides them. I guess that improves response time. (The thought just occured to me. If they are just hidden, that means that they are still instantiated and active. Perhaps they could be responding to events?) So I have to slog through that. Perhaps I could figure out a way not to have to slog through the opening events by making more creative use of the debugger. I am used to VB.BET VS IDE so the debugger in MS-Access looks a little wanting by comparison.

I am feeling a little guilty and concerned to have put so much time into something that my client didn't specificly ask for and he could have. We reviewed all this stuff. He indicated that he was OK using MS-Access IDE inserting his new Wholesale customers. I am also concerned that he is going to be disappointed for me not having more to show for my time. I have another customer that I have to keep satisified with at least a little enhancement once a month. The customer waiting on this MS-Access Sales Order application, will be over a month without receiving anything from me. So I better get cracking on something he really wants.

Thank you for your help. If I resume working on it at some point in the future, I will be much farther along for what you have given me.

TedPalmer
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.