[RESOLVED] Application Hang Category: (101) Event ID: 1002

[aburn]

I have an application written in VB5, VB6, C++, etc.. the application stores data on a remote server in a Microsoft Access database. The software runs fine on the server where we have the main database files as opposed to the mover files on the separate data entry stations but hangs when you drill down to the frmOrder (source code below) on one of the data entry stations. I tried using Dbgview with no luck (may be the XP operating system on the data entry machine). Can't figure out what is causing the exception that is stopping the program. I compared a good database file vs the "bad" files to see if I could spot an invalid or corrupt record...or even something that I didn't allow for being in one of the fields, but didn't have any luck though it's been running for a long time for something like that to show up now. The data integrity looks good to say the least.

[aburn]

Source code from frmOrder:

Option Explicit
'I sure would have done this a lot different if ADO had existed when I wrote it

Public fInmate As frmInmateSelect
Dim Updated As Boolean
Dim LastRow As Long
Dim Busy As Boolean
Public NewBalance As Currency
Public SubTotal As Currency
Public Tax As Currency
Public Total As Currency
Private QuickActive As Boolean
Private OrderID As Long
Private TransactionID As Long
Private UsingQuickFind As Boolean
Private ValidEntry As Boolean
Private PostedTransactionsTotal As Currency
Private PostedTransactionsCount As Integer

'used to flag that an order was open with invalid amounts to prevent repeated warning in entry screen
Private LoadedWithInvalidAmounts As Boolean

Private MaxOrderExemptCategories As String
Private MaxOrderExemptLimit As Currency
Private MaxOrderExemptAmount As Currency

Private CatLimits As COrderLimitCategories

Private Sub SetControls()
    Dim m As Variant

    On Error Resume Next
    For Each m In Me.Controls
        If Len(m.tag) > 0 Then 'don't do nothing if tag not set
            If (CurrentUser.SecurityToken = "*") Or (Val(CurrentUser.SecurityToken) >= Val(m.tag)) Then
                m.Visible = True
                m.Enabled = True
            Else
                m.Visible = False
                m.Enabled = False
            End If
        End If
    Next
End Sub

Private Function SetOrderLimitedItems() As Boolean
    'read the grid, return true if any limit category is over allowed
    Dim row As Integer
    
    CatLimits.ClearAll
    With FGrid1
        For row = 0 To .rows - 1
            CatLimits.AddCount .TextMatrix(row, 9), Val(.TextMatrix(row, 10)) * Val(.TextMatrix(row, 0))
        Next
    End With
    SetOrderLimitedItems = CatLimits.Over
End Function

Private Function VerifyOrderAmounts() As Integer
    VerifyOrderAmounts = 0
    If NewBalance < CurrentSession.MinimumBalance Then
        VerifyOrderAmounts = 1
    ElseIf (Total - MaxOrderExemptAmount) > CurrentSession.MaximumOrder And CurrentSession.MaximumOrder > 0# Then
        VerifyOrderAmounts = 2
    ElseIf MaxOrderExemptAmount > MaxOrderExemptLimit Then
        VerifyOrderAmounts = 3
    ElseIf SetOrderLimitedItems Then
        VerifyOrderAmounts = 4
    End If
End Function

Private Sub CommitOrder()
'update account balance
'make account transaction entry
'add to order table(s)

    Dim row As Integer
    Dim col As Integer
    Dim s As String
    Dim posStart As Long
    Dim bal As Currency
    Dim c As Currency
    Dim d As Currency

    'set stuff in the order table
    dbOrder.Recordset.Edit
    If IsNull(dbOrder.Recordset.Fields("FirstEntryTime")) Then
        dbOrder.Recordset.Fields("FirstEntryTime") = Now
    End If
    dbOrder.Recordset.Fields("LastEntryTime") = Now
    dbOrder.Recordset.Fields("SalesTax") = CurrentLocation.SalesTax
    dbOrder.Recordset.Fields("Rebate") = CurrentLocation.Rebate
    dbOrder.Recordset.Update

    'make the new transaction if not one already there
    With dbAcntTrans.Recordset
        If TransactionID = -1 Then
            s = "SELECT Max(TransactionID) AS [Next] From AccountTransactions where " _
                & "AccountId = '" & CurrentAccount.AccountID & "'" _
                & " and LocationID = '" & CurrentLocation.LocationID & "'"
            dbTransID.RecordSource = s
            dbTransID.Refresh
            If IsNull(dbTransID.Recordset.Fields(0)) Then
                TransactionID = 1
            Else
                TransactionID = dbTransID.Recordset.Fields(0) + 1
            End If
            s = "SELECT * From AccountTransactions where " _
                & " AccountId = '" & CurrentAccount.AccountID & "'" _
                & " and LocationID = '" & CurrentLocation.LocationID & "'"
            dbAcntTrans.RecordSource = s
            dbAcntTrans.Refresh
            .AddNew
            .Fields("TransactionID") = TransactionID
            .Fields("TransactionCode") = "Commissary Order"
            .Fields("AccountID") = CurrentAccount.AccountID
            .Fields("DateTime") = Now
            .Fields("Description") = "Commissary Order #" & Str$(OrderID)
            .Fields("LocationID") = CurrentLocation.LocationID
            .Update
            s = "SELECT * From AccountTransactions where " _
                & " AccountId = '" & CurrentAccount.AccountID & "'" _
                & " and TransactionID = " & Str$(TransactionID) _
                & " and LocationID = '" & CurrentLocation.LocationID & "'"
            dbAcntTrans.RecordSource = s
            dbAcntTrans.Refresh
        End If
    End With

    'delete items already in database
    s = "Select * from Items where " _
        & " LocationID = '" & CurrentLocation.LocationID & "' and" _
        & " AccountID = '" & CurrentAccount.AccountID & "' and" _
        & " OrderID = " & Str$(OrderID)
    dbItem.RecordSource = s
    dbItem.Refresh
    With dbItem.Recordset
        If Not .EOF Then ' then this is edit, not new
            .MoveFirst
            While Not .EOF
                .Delete
                .MoveNext
            Wend
        End If
    End With

    'scan the form and put into item records
    Debug.Print "Order for: "; CurrentAccount.FirstName; " "; CurrentAccount.MiddleName; " "; CurrentAccount.LastName
    With FGrid1
        For row = 0 To .rows - 1
            If Val(.TextMatrix(row, 0)) > 0 Then
                For col = 0 To .Cols - 1
                    Debug.Print .TextMatrix(row, col); ",";
                Next
                Debug.Print
                With dbItem.Recordset
                    .AddNew
                    .Fields("OrderID") = OrderID
                    .Fields("LocationID") = CurrentLocation.LocationID
                    .Fields("AccountID") = CurrentAccount.AccountID
                    .Fields("TransactionID") = TransactionID
                    .Fields("ProductID") = FGrid1.TextMatrix(row, 1)
                    .Fields("Description") = FGrid1.TextMatrix(row, 2)
                    .Fields("Quantity") = Val(FGrid1.TextMatrix(row, 0))
                    .Fields("Price") = Val(FGrid1.TextMatrix(row, 3))
                    .Fields("Cost") = Val(FGrid1.TextMatrix(row, 8))
                    .Fields("Taxrate") = Val(FGrid1.TextMatrix(row, 5))
                    .Fields("Rebate") = Val(FGrid1.TextMatrix(row, 6))
                    .Update
                End With
            End If
        Next
        Debug.Print "SubTotal:", Format(SubTotal, "0.00")
        Debug.Print "     Tax:", Format(Tax, "0.00")
        Debug.Print "   Total:", Format(Total, "0.00")
        Debug.Print " Balance:", Format(NewBalance, "0.00")
    End With

    'update the transaction
    dbAcntTrans.Recordset.Edit
    dbAcntTrans.Recordset.Fields("Debit") = Total
    dbAcntTrans.Recordset.Update

    'update account balance
    CurrentAccount.CurrentBalance = RndCur(CurrentAccount.CurrentBalance) - Total
    fInmate.UserRecord.Edit
    fInmate.UserRecord.Fields("CurrentBalance") = CurrentAccount.CurrentBalance
    fInmate.UserRecord.Update

    datCalc.Refresh
    With datCalc.Recordset
        posStart = dbAcntTrans.Recordset.AbsolutePosition - 1
        If posStart < 5 Then
            bal = 0#
            .MoveFirst
        Else
            .AbsolutePosition = posStart
            bal = RndCur(.Fields("Balance"))
            .MoveNext
        End If
        While Not .EOF
            If IsNull(.Fields("Credit")) Then
                c = 0
            Else
                c = .Fields("Credit")
            End If
            If IsNull(.Fields("Debit")) Then
                d = 0
            Else
                d = .Fields("Debit")
            End If
            bal = bal + RndCur(c)
            bal = bal - RndCur(d)
            .Edit
            .Fields("Balance") = bal
            .Update
            .MoveNext
        Wend
    End With
End Sub


Private Sub MoveTextBox()
    On Error Resume Next
    With FGrid1
        If .RowIsVisible(.row) And .RowIsVisible(.row + 1) Then
            Text1.Left = .CellLeft + FGrid1.Left
            Text1.Top = .CellTop + FGrid1.Top
            Text1.Height = .CellHeight
            Text1.Width = .CellWidth
            Text1.Visible = True
            Text1.SetFocus
       Else
            Text1.Visible = False
        End If
    End With
End Sub

Private Sub NextRow()
    Dim row As Long

    On Error Resume Next
    With FGrid1
        row = .row + 1
        If row < .rows Then
            .row = row
        End If
        If Not .RowIsVisible(row + 1) Then
            .TopRow = .TopRow + 1
        End If
    End With
End Sub

[aburn]

Private Sub PrevRow()
Dim row As Long
row = FGrid1.row - 1
If row > FGrid1.FixedRows Then
FGrid1.row = row
End If
If Not FGrid1.RowIsVisible(row) Then
FGrid1.TopRow = row
End If
End Sub

Private Sub UpdateRow(row As Long)
Dim oldprice As Currency
Dim newprice As Currency
Dim sh As String
Dim tmpNewBalance As Currency
Dim tmpSubTotal As Currency
Dim tmpMaxOrderExemptAmount As Currency
Dim tmpTax As Currency
Dim tmpTotal As Currency
Dim IsExempt As Boolean

Debug.Print "UpdateRow"
On Error Resume Next
ValidEntry = True
With FGrid1
IsExempt = (0 < Len(Intersect(MaxOrderExemptCategories, .TextMatrix(row, 9))))
oldprice = Val(.TextMatrix(row, 4))
newprice = Val(.TextMatrix(row, 0)) * Val(.TextMatrix(row, 3))
If oldprice <> newprice Then
sh = Intersect(CurrentAccount.SpecialHandling, .TextMatrix(row, 7))
If Len(sh) > 0 Then
If Not (MsgBox("Special handling conflict: " & sh & vbCrLf & "Allow item anyway?", vbYesNo) = vbYes) Then
.TextMatrix(row, 0) = ""
newprice = 0#
ValidEntry = False
End If
End If
End If
If newprice > 0 Then
.TextMatrix(row, 4) = Format(newprice, "0.00")
Else
.TextMatrix(row, 4) = ""
End If
If IsExempt Then
tmpMaxOrderExemptAmount = MaxOrderExemptAmount - oldprice - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice) + newprice + (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * newprice)
Else
tmpMaxOrderExemptAmount = MaxOrderExemptAmount
End If
tmpSubTotal = SubTotal - oldprice + newprice
tmpTax = Tax - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
tmpTax = tmpTax + (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * newprice)
tmpTotal = RndCur(tmpSubTotal) + RndCur(tmpTax)
tmpNewBalance = RndCur(CurrentAccount.CurrentBalance) - tmpTotal
If (Not LoadedWithInvalidAmounts) And (tmpNewBalance < CurrentSession.MinimumBalance) Then
.TextMatrix(row, 0) = ""
.TextMatrix(row, 4) = ""
Text1.Text = ""
newprice = 0#
If oldprice <> 0 Then
If IsExempt Then
MaxOrderExemptAmount = MaxOrderExemptAmount - oldprice - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
End If
SubTotal = SubTotal - oldprice
Tax = Tax - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
Total = RndCur(tmpSubTotal) + RndCur(tmpTax)
NewBalance = RndCur(CurrentAccount.CurrentBalance) - tmpTotal
End If
MsgBox "Resulting balance of " & Format(tmpNewBalance, "$0.00") & vbCrLf & " falls below minimum allowed balance of " & Format(CurrentSession.MinimumBalance, "$0.00"), vbCritical
ValidEntry = False
FGrid1.SetFocus
ElseIf (Not LoadedWithInvalidAmounts) And (((tmpTotal - tmpMaxOrderExemptAmount) > CurrentSession.MaximumOrder) And (CurrentSession.MaximumOrder > 0#)) Then
.TextMatrix(row, 0) = ""
.TextMatrix(row, 4) = ""
Text1.Text = ""
newprice = 0#
If oldprice <> 0 Then
If IsExempt Then
MaxOrderExemptAmount = MaxOrderExemptAmount - oldprice - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
End If
SubTotal = SubTotal - oldprice
Tax = Tax - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
Total = RndCur(tmpSubTotal) + RndCur(tmpTax)
NewBalance = RndCur(CurrentAccount.CurrentBalance) - tmpTotal
End If
MsgBox "Order amount of " & Format(tmpTotal, "$0.00") & vbCrLf & "exceeds maximum allowed order of " & Format(CurrentSession.MaximumOrder, "$0.00"), vbCritical
ValidEntry = False
FGrid1.SetFocus
ElseIf (Not LoadedWithInvalidAmounts) And (tmpMaxOrderExemptAmount > MaxOrderExemptLimit) Then
.TextMatrix(row, 0) = ""
.TextMatrix(row, 4) = ""
Text1.Text = ""
newprice = 0#
If oldprice <> 0 Then
If IsExempt Then
MaxOrderExemptAmount = MaxOrderExemptAmount - oldprice - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
End If
SubTotal = SubTotal - oldprice
Tax = Tax - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
Total = RndCur(tmpSubTotal) + RndCur(tmpTax)
NewBalance = RndCur(CurrentAccount.CurrentBalance) - tmpTotal
End If
MsgBox "Exeeds maximum exempt order item amount", vbCritical
ValidEntry = False
FGrid1.SetFocus
'ElseIf (Not LoadedWithInvalidAmounts) And CatLimits.AddCount(.TextMatrix(row, 9), Val(.TextMatrix(row, 10)) * Val(.TextMatrix(row, 0))) Then
ElseIf (Not LoadedWithInvalidAmounts) And SetOrderLimitedItems Then
.TextMatrix(row, 0) = ""
.TextMatrix(row, 4) = ""
Text1.Text = ""
newprice = 0#
If oldprice <> 0 Then
If IsExempt Then
MaxOrderExemptAmount = MaxOrderExemptAmount - oldprice - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
End If
SubTotal = SubTotal - oldprice
Tax = Tax - (CurrentLocation.SalesTax * Val(.TextMatrix(row, 5)) * oldprice)
Total = RndCur(tmpSubTotal) + RndCur(tmpTax)
NewBalance = RndCur(CurrentAccount.CurrentBalance) - tmpTotal
End If
MsgBox "Maximum number of limited items exceeded", vbCritical
ValidEntry = False
FGrid1.SetFocus
Else
If IsExempt Then
MaxOrderExemptAmount = tmpMaxOrderExemptAmount
End If
SubTotal = tmpSubTotal
Tax = tmpTax
Total = tmpTotal
NewBalance = tmpNewBalance
lblSub.Caption = Format(SubTotal, "$0.00")
lblTax.Caption = Format(Tax, "$0.00")
lblTotal.Caption = Format(Total, "$0.00")
lblEndBal.Caption = Format(NewBalance, "$0.00")
End If
End With
Debug.Print "Subtotal: " & Format(SubTotal, "$0.00") & "ExemptAmount: " & Format(MaxOrderExemptAmount, "$0.00")
End Sub

Private Sub btnCancel_Click()
Dim s As String

If SubTotal <> 0# Then
If MsgBox("Are you sure you wish to cancel the items on this order?", vbYesNo) <> vbYes Then
Exit Sub
End If
End If

With dbAcntTrans
If TransactionID <> -1 Then
s = "SELECT * From AccountTransactions where " _
& " AccountId = '" & CurrentAccount.AccountID & "'" _
& " and TRansactionID = " & Str$(TransactionID) _
& " and LocationID = '" & CurrentLocation.LocationID & "'"
.RecordSource = s
.Refresh
.Recordset.Delete
.Recordset.MoveNext
End If
End With
Me.Hide
End Sub

Private Sub btnCheck_Click()
Dim f As New frmCheck

Set f = New frmCheck
Set f.RSInmate = fInmate.UserRecord
f.TransactionID = 0
f.Show vbModal, Me
lblBegBal.Caption = Format(CurrentAccount.CurrentBalance, "$0.00")
lblEndBal.Caption = Format(CCur(lblBegBal.Caption) - CCur(lblTotal.Caption), "$0.00")
End Sub

[aburn]

Private Sub btnOK_Click()
Dim voa As Integer

voa = VerifyOrderAmounts()
Select Case True
Case 0 = voa
CommitOrder
Me.Hide
Case 1 = voa
MsgBox "Resulting balance of " & Format(NewBalance, "$0.00") & vbCrLf & " falls below minimum allowed balance of " & Format(CurrentSession.MinimumBalance, "$0.00"), vbCritical
Case 2 = voa
MsgBox "Order amount of " & Format(Total, "$0.00") & vbCrLf & "exceeds maximum allowed order of " & Format(CurrentSession.MaximumOrder, "$0.00"), vbCritical
Case 3 = voa
MsgBox "Exeeds maximum exempt order item amount", vbCritical
Case 4 = voa
MsgBox "Maximum number of limited items exceeded", vbCritical
End Select
End Sub

Private Sub Check1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Check1.Value = vbUnchecked Then
FGrid1.SetFocus
ElseIf Check1.Value = vbChecked Then
txtQuickFind.SetFocus
End If
End Sub

Private Sub FGrid1_EnterCell()
MoveTextBox
Text1.Text = FGrid1.Text
Text1.SelStart = 0
Text1.SelLength = 99
Debug.Print "Enter Cell", FGrid1.row
End Sub

Private Sub FGrid1_GotFocus()
MoveTextBox
End Sub

Private Sub FGrid1_LeaveCell()
If Busy Then Exit Sub
FGrid1.Text = Text1.Text
UpdateRow FGrid1.row
Debug.Print "Leave Cell", FGrid1.row
End Sub

Private Sub FGrid1_RowColChange()
If Busy Then Exit Sub
Busy = True
With FGrid1
.col = 0
If .TextMatrix(.row, 0&) = "----" Then
Busy = False
If .row > LastRow Or .row = .FixedRows Then
NextRow
ElseIf .row < LastRow Then
PrevRow
End If
DoEvents
Exit Sub
End If
.RowSel = .row
.ColSel = .Cols - 1
LastRow = .row
End With
'Text1.SelStart = 0
'Text1.SelLength = 99
Busy = False
Debug.Print "RowCol Change"
End Sub

Private Sub FGrid1_Scroll()
With FGrid1
MoveTextBox
Debug.Print .RowIsVisible(.row)
End With
End Sub

Private Sub FGrid1_SelChange()
With FGrid1
Debug.Print "SelChange", .row, .col, .RowSel, .ColSel
' .RowSel = .row
' .ColSel = .Cols - 1
End With
End Sub

Private Sub Form_GotFocus()
Debug.Print "Form_GotFocus"
MoveTextBox
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim rows As Long
Dim NewRow As Long

With FGrid1
Debug.Print "Form_KeyDown "; KeyCode, Shift
If KeyCode = 40 Then
NextRow
KeyCode = 0
ElseIf KeyCode = 38 Then
PrevRow
KeyCode = 0
ElseIf KeyCode = 33 Then 'page up
rows = .Height \ (.RowPos(2) - .RowPos(1)) - 2
NewRow = .row - rows
If NewRow < .FixedRows Then
NewRow = .FixedRows
End If
.row = NewRow
.TopRow = NewRow
ElseIf KeyCode = 34 Then 'page down
rows = .Height \ (.RowPos(2) - .RowPos(1)) - 2
NewRow = .row + rows
If NewRow >= .rows Then
NewRow = .rows - 1
End If
.row = NewRow
.TopRow = NewRow
End If
End With
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Debug.Print "Form_KeyPress "; KeyAscii
If KeyAscii = 13 Then ' CR
If Check1.Value = vbChecked Then
If QuickActive Then
QuickSel
Else
FGrid1.Text = Text1.Text
UpdateRow FGrid1.row
txtQuickFind.SetFocus
End If
Else
'FGrid1.Text = Text1.Text
'UpdateRow FGrid1.row
NextRow
End If
KeyAscii = 0
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim rtn As Long
Dim s As String

LogMessage "Screen Opened: " & Me.name
Screen.MousePointer = vbHourglass
Updated = False
Busy = False
LastRow = -1
QuickActive = False
TransactionID = -1
OrderID = -1
SubTotal = 0#
MaxOrderExemptAmount = 0#
Total = 0#
Tax = 0#

'set up for registery access
SysReg.Root = HKEY_LOCAL_MACHINE
SysReg.KeyPrefix = "SOFTWARE\......\" 'Romved KeyPrefix, but I know this is correct

'get and validate screen position
Dim tmp As Integer
tmp = SysReg.GetSetting(Me.Caption, "Size", "Width", -1)
If tmp > -1 Then Me.Width = tmp
tmp = SysReg.GetSetting(Me.Caption, "Size", "Left", -1)
If tmp > -1 Then Me.Left = tmp
If Me.Left > Screen.Width - Me.Width Then
Me.Left = Screen.Width - Me.Width
ElseIf Me.Left < 0 Then
Me.Left = 0
End If
tmp = SysReg.GetSetting(Me.Caption, "Size", "Height", -1)
If tmp > -1 Then Me.Height = tmp
tmp = SysReg.GetSetting(Me.Caption, "Size", "Top", -1)
If tmp > -1 Then Me.Top = tmp
If Me.Top > Screen.Height - Me.Height Then
Me.Top = Screen.Height - Me.Height
ElseIf Me.Top < 0 Then
Me.Top = 0
End If
Me.WindowState = SysReg.GetSetting(Me.Caption, "Size", "State", vbNormal)
Check1.Value = SysReg.GetSetting(Me.Caption, "Settings", "Quick Entry", 0)
For i = 0 To FGrid1.Cols - 1
rtn = SysReg.GetSetting(Me.Caption, "Size", "ColWidth" & Trim$(Str$(i)), -1)
If rtn > 0 Then FGrid1.ColWidth(i) = rtn
Next


MaxOrderExemptCategories = SysReg.GetSetting("Program", "Settings", "MaxOrderExemptCategories", DefaultMaxOrderExemptCategories)
MaxOrderExemptLimit = SysReg.GetSetting("Program", "Settings", "MaxOrderExemptLimit", DefaultMaxOrderExemptLimit)

' Set fInmate = New frmInmateSelect
' fInmate.Show vbModal
Label1.Caption = CurrentAccount.FirstName & " " & CurrentAccount.MiddleName & " " & CurrentAccount.LastName

FGrid1.ColAlignment(0) = flexAlignRightCenter
FGrid1.ColAlignment(1) = flexAlignLeftCenter
FGrid1.ColAlignment(2) = flexAlignRightCenter
FGrid1.ColAlignment(3) = flexAlignRightCenter
FGrid1.ColAlignment(4) = flexAlignRightCenter
'invisible columns used as array elements
FGrid1.ColWidth(5) = 0 'rebate
FGrid1.ColWidth(6) = 0 'tax rate
FGrid1.ColWidth(7) = 0 'special handling
FGrid1.ColWidth(8) = 0 'cost
FGrid1.ColWidth(9) = 0 'category
FGrid1.ColWidth(10) = 0 'OnHand used for order limit counting
FGrid1.ColWidth(11) = 0 'blank end

FGrid1.TextMatrix(0, 0) = "Quantity"
FGrid1.TextMatrix(0, 1) = "Item"
FGrid1.TextMatrix(0, 2) = "Description"
FGrid1.TextMatrix(0, 3) = "Each"
FGrid1.TextMatrix(0, 4) = "Price"

NewBalance = CurrentAccount.CurrentBalance

'set database path and do all the crap needed to make that work
On Error Resume Next
With dbProduct
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
.Refresh
.Recordset.MoveFirst
End With
'
With dbCat
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
.Refresh
.Recordset.MoveFirst
End With
'
With dbOrder
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
.Refresh
.Recordset.MoveFirst
End With
'
With dbItem
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
.Refresh
.Recordset.MoveFirst
End With
'
With dbTransID
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
.Refresh
.Recordset.MoveFirst
End With
'
With dbAcntTrans
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
.Refresh
.Recordset.MoveFirst
End With
'
With datCalc
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
s = Trim$(CurrentAccount.AccountID)
s = "select Debit,Credit,Balance,AccountID,LocationID from AccountTransactions where AccountId = '" & s & "' and LocationID = '" & CurrentLocation.LocationID & "' Order by TransactionID"
.RecordSource = s
.Refresh
.Recordset.MoveFirst
End With

With dbPostQ
.DatabaseName = SetDatabaseName(.DatabaseName, DatabasePath)
s = "SELECT * from Postings where [AccountID] = '" & CurrentAccount.AccountID & "' and [Posted] = 0 and [LocationID] = '" & CurrentLocation.LocationID & "' order by AccountName, EntryDate"
.RecordSource = s
.Refresh
With .Recordset
PostedTransactionsTotal = 0
PostedTransactionsCount = 0
.MoveFirst
While Not .EOF
PostedTransactionsCount = PostedTransactionsCount + 1
If .Fields("Credit") Then
PostedTransactionsTotal = PostedTransactionsTotal + .Fields("Amount")
Else
PostedTransactionsTotal = PostedTransactionsTotal - .Fields("Amount")
End If
.MoveNext
Wend
End With
End With

Set CatLimits = New COrderLimitCategories
SetControls
DisplayOrderForm
Timer1.Enabled = True
End Sub

[aburn]

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
Cancel = True
btnCancel_Click
End If
Debug.Print "QueryUnload "; UnloadMode
End Sub

Private Sub Form_Resize()
Dim l As Long
Dim TopRow As Long

On Error Resume Next
Busy = True
TopRow = FGrid1.TopRow

'lblBalance.Left = Me.ScaleWidth - Label1.Left - lblBalance.Width
'Label2.Left = lblBalance.Left - Label2.Width

btnCancel.Top = Me.ScaleHeight - btnCancel.Height - 60
btnCancel.Left = Me.ScaleWidth - btnCancel.Width - 120

btnOK.Top = Me.ScaleHeight - btnOK.Height - 60
btnOK.Left = btnCancel.Left - btnOK.Width - 120

lblTotal.Top = btnCancel.Top - lblTotal.Height - 180
lblTotal.Left = Me.ScaleWidth - lblTotal.Width - 120
lTotal.Top = lblTotal.Top
lTotal.Left = lblTotal.Left - lTotal.Width - 60

lblTax.Top = lblTotal.Top - lblTax.Height
lblTax.Left = Me.ScaleWidth - lblTax.Width - 120
lTax.Top = lblTax.Top
lTax.Left = lblTax.Left - lTax.Width - 60
'
lblBegBal.Top = lblTax.Top
Label2.Top = lblTax.Top
btnCheck.Top = lblTax.Top

lblSub.Top = lblTax.Top - lblSub.Height
lblSub.Left = Me.ScaleWidth - lblSub.Width - 120
lSub.Top = lblSub.Top
lSub.Left = lblSub.Left - lSub.Width - 60
'
lblEndBal.Top = lblTotal.Top
Label3.Top = lblTotal.Top
'
Label1.Top = lblSub.Top

l = lblSub.Top - FGrid1.Top - 60
If l < 0 Then l = 0
FGrid1.Height = l

Check1.Top = Me.ScaleHeight - Check1.Height - 60
txtQuickFind.Top = Me.ScaleHeight - txtQuickFind.Height - 60
txtQuickFind.Left = Check1.Left + Check1.Width

FGrid1.Width = Me.ScaleWidth
If Updated Then
FGrid1.col = 0
'FGrid1.Row = 1
'l = FGrid1.CellLeft * 6.5

'l = FGrid1.Width _
- l _
- FGrid1.GridLineWidth * 6 _
- FGrid1.ColWidth(0) _
- FGrid1.ColWidth(1) _
- FGrid1.ColWidth(3) _
- FGrid1.ColWidth(4)
'If l > 0 Then FGrid1.ColWidth(2) = l
FGrid1.ColWidth(5) = 0
FGrid1.ColWidth(6) = 0
FGrid1.ColWidth(7) = 0
FGrid1.ColWidth(8) = 0
FGrid1.TopRow = TopRow
LastRow = FGrid1.row
MoveTextBox
End If
Busy = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer

LogMessage "Screen Closed: " & Me.name

Set CatLimits = Nothing

If Me.WindowState <> vbMinimized Then
SysReg.SaveSetting Me.Caption, "Size", "State", Me.WindowState
If Me.WindowState = vbNormal Then
SysReg.SaveSetting Me.Caption, "Size", "Left", Me.Left
SysReg.SaveSetting Me.Caption, "Size", "Top", Me.Top
SysReg.SaveSetting Me.Caption, "Size", "Width", Me.Width
SysReg.SaveSetting Me.Caption, "Size", "Height", Me.Height
End If
End If
SysReg.SaveSetting Me.Caption, "Settings", "Quick Entry", Check1.Value
For i = 0 To FGrid1.Cols - 1
SysReg.SaveSetting Me.Caption, "Size", "ColWidth" & Trim$(Str$(i)), FGrid1.ColWidth(i)
Next
' If Not fInmate Is Nothing Then
' Unload fInmate
' Set fInmate = Nothing
' End If
End Sub

Private Sub Label1_Click()
Debug.Print "Break"
End Sub

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = 99
End Sub

Private Sub Text1_LostFocus()
FGrid1.Text = Text1.Text
UpdateRow FGrid1.row
End Sub

Private Sub DisplayOrderForm()
Dim qry As String
Dim s As String
Dim s2 As String
Dim Cat, catcode As String
Dim Price As Currency
Dim doHeader As Boolean
Dim NewOrder As Boolean
Dim i As Long

On Error Resume Next
If Not CurrentAccount.PurchaseRights = True Then
MsgBox "This account does not have purchase rights"
'Me.Hide
Me.Visible = False
Screen.MousePointer = vbDefault
SendKeys ("{ESC}")
Exit Sub
End If
With dbCat.Recordset
.MoveFirst
While Not .EOF
catcode = .Fields("CategoryCode")
Cat = .Fields("Description")
doHeader = True
With dbProduct.Recordset
.FindFirst "[CategoryCode] = '" & catcode & "'"
While Not .NoMatch
If .Fields("Active") Then
If (Len(CurrentSession.SessionGroups) = 0) _
Or (Len(.Fields("SessionGroups")) = 0) _
Or (Len(Intersect(CurrentSession.SessionGroups, .Fields("SessionGroups"))) > 0) Then
If doHeader Then
doHeader = False
FGrid1.AddItem "----" & vbTab & "----" & vbTab & Cat
End If

s = vbTab & .Fields("ProductID") _
& vbTab & .Fields("Description") _
& vbTab
Price = 0#
If CurrentLocation.PriceIndex > 0 And CurrentLocation.PriceIndex < 5 Then
s2 = "AlternatePrice" & Trim$(CurrentLocation.PriceIndex)
Price = .Fields(s2)
End If
If Price = 0# Then
Price = .Fields("Price")
End If
'starts at colum 3
' 3 4 5 6
s = s + Format(Price, "0.00") + vbTab + vbTab + Str$(.Fields("Taxrate")) + vbTab + Str$(.Fields("Rebate"))
If IsNull(.Fields("SpecialHandling")) Then
s = s + vbTab + ""
Else
' 7
s = s + vbTab + .Fields("SpecialHandling")
End If
' 8
s = s + vbTab + Str$(.Fields("Cost"))

' 9
s = s + vbTab + Trim(catcode)
' 10
s = s + vbTab + Str$(.Fields("QuantityOnHand"))
FGrid1.AddItem s
End If
End If
.FindNext "[CategoryCode] = '" & catcode & "'"
Wend
End With
.MoveNext
Wend
End With

s = "SELECT Max(OrderID) From Orders where LocationID = '" _
& CurrentLocation.LocationID & "'"
dbOrder.RecordSource = s
dbOrder.Refresh
If IsNull(dbOrder.Recordset.Fields(0)) Then
OrderID = 1
Else
OrderID = dbOrder.Recordset.Fields(0)
End If
s = "SELECT * from Orders where " _
& "LocationID = '" & CurrentLocation.LocationID & "' and " _
& "OrderID = " & Str$(OrderID)
dbOrder.RecordSource = s
dbOrder.Refresh
NewOrder = False
If dbOrder.Recordset.EOF Then
NewOrder = True
Else
If Not IsNull(dbOrder.Recordset.Fields("TransmitTime")) Then
NewOrder = True
OrderID = OrderID + 1
End If
End If

If NewOrder Then
'create new order record
dbOrder.Recordset.AddNew
dbOrder.Recordset.Fields("OrderID") = OrderID
dbOrder.Recordset.Fields("LocationID") = CurrentLocation.LocationID
dbOrder.Recordset.Update
dbOrder.Recordset.Bookmark = dbOrder.Recordset.LastModified
Else
'see if account already has items in this order
'put already ordered items in form
'delete them from the database...
'...this allows [Cancel] to cancel an order
'find transaction for this order
'adjust balances, zero transaction

'set recordset to this account's order items
s = "Select * from Items where " _
& " LocationID = '" & CurrentLocation.LocationID & "' and" _
& " AccountID = '" & CurrentAccount.AccountID & "' and" _
& " OrderID = " & Str$(OrderID)
dbItem.RecordSource = s
dbItem.Refresh
With dbItem.Recordset
If Not .EOF Then ' then this is edit, not new
.MoveFirst
TransactionID = Val(.Fields("TransactionID"))

'find the transaction for this order
s = "SELECT * From AccountTransactions where " _
& " AccountId = '" & CurrentAccount.AccountID & "'" _
& " and TransactionID = " & Str$(TransactionID) _
& " and LocationID = '" & CurrentLocation.LocationID & "'"
dbAcntTrans.RecordSource = s
dbAcntTrans.Refresh

If Not dbAcntTrans.Recordset.EOF Then
'adjust balance
CurrentAccount.CurrentBalance = CurrentAccount.CurrentBalance + dbAcntTrans.Recordset.Fields("Debit")
fInmate.UserRecord.Edit
fInmate.UserRecord.Fields("CurrentBalance") = CurrentAccount.CurrentBalance
fInmate.UserRecord.Update

'zero transaction amount
dbAcntTrans.Recordset.Edit
dbAcntTrans.Recordset.Fields("Debit") = 0#
dbAcntTrans.Recordset.Update
Else
'somebody deleted the transaction!!
TransactionID = -1
End If

'loop through all order items to put in form
Tax = 0#
While Not .EOF
For i = 0 To FGrid1.rows - 1
If Trim$(.Fields("ProductID")) = FGrid1.TextMatrix(i, 1) Then
FGrid1.TextMatrix(i, 0) = Trim$(Str$(.Fields("Quantity")))
Price = Val(FGrid1.TextMatrix(i, 0)) * Val(FGrid1.TextMatrix(i, 3))
FGrid1.TextMatrix(i, 4) = Format(Price, "0.00")
If 0 < Len(Intersect(FGrid1.TextMatrix(i, 9), MaxOrderExemptCategories)) Then
MaxOrderExemptAmount = MaxOrderExemptAmount + Price + (CurrentLocation.SalesTax * Val(FGrid1.TextMatrix(i, 5)) * Price)
End If
SubTotal = SubTotal + Price
Tax = Tax + CurrentLocation.SalesTax * Val(FGrid1.TextMatrix(i, 5)) * Price
Exit For
End If
Next
.Delete
.MoveNext
Wend
Total = RndCur(SubTotal) + RndCur(Tax)
NewBalance = RndCur(CurrentAccount.CurrentBalance) - Total
End If
End With

End If

LoadedWithInvalidAmounts = (VerifyOrderAmounts > 0)

'display form totals
lblSub.Caption = Format(SubTotal, "$0.00")
lblTax.Caption = Format(Tax, "$0.00")
lblTotal.Caption = Format(Total, "$0.00")
lblBegBal.Caption = Format(CurrentAccount.CurrentBalance, "$0.00")
lblEndBal.Caption = Format(NewBalance, "$0.00")
Debug.Print "MaxOrderExemptAmount: " + Format(MaxOrderExemptAmount, "0.00")

' FGrid1.col = 3
Updated = True
Form_Resize
FGrid1_RowColChange
Screen.MousePointer = vbDefault

End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
If Check1.Value Then
txtQuickFind.SetFocus
End If
If PostedTransactionsCount > 0 Then
MsgBox "This account has " & Format(PostedTransactionsCount) & " posted transactions totaling " & Format(PostedTransactionsTotal, "$0.00"), vbInformation
End If
End Sub

Private Sub txtQuickFind_LostFocus()
QuickActive = False
Debug.Print "txtQuickFind_LostFocus"
End Sub

Private Sub QuickSel()
Dim NewRow As Long
Dim i As Long
Dim s As String
Dim found As Boolean

On Error Resume Next
s = Trim$(txtQuickFind.Text)
If Len(s) > 0 Then
found = False
For i = 0 To FGrid1.rows - 1
If s = Trim$(FGrid1.TextMatrix(i, 1)) Then
found = True
Exit For
End If
Next
If found Then
'If FGrid1.row <> i Then
FGrid1.row = i
If Not FGrid1.RowIsVisible(i + 1) Then
FGrid1.TopRow = i
End If
FGrid1.SetFocus
'End If
Else
Beep
txtQuickFind_GotFocus
End If
End If
End Sub

Private Sub txtQuickFind_GotFocus()
Debug.Print "txtQuickFind_GotFocus"
txtQuickFind.SelStart = 0
txtQuickFind.SelLength = 99
QuickActive = True
End Sub

[Nightwalker83]

@ aburn

Please wrap your code in [highlight="vb"][/highlight] it will make the code easier for people to read.

@ jmsrickland

Your post doesn't add anything useful to the discussion so please keep that stuff to the chit-chat section.

[aburn]

Nightwalker83 I will ensure to do that next time. I resolved the issue..wasn't software related. The permissions weren't set correctly on the server. This should have been taken care of by our networking contractors but I took care of it.

Thanks