Avatar of captgriggs
captgriggs asked on

Access 2003 runtime error 6 overflow

I can't seem to work the bugs out of this database. This is the last one and it's wearing me out. I only get it on some entries. Does ayone have any suggestions?  Thanks all for looking!

When I debug, this is the area that gets highlighted.
 If Format(Me.ListCards.Column(2), "Short Date") < Date Then If Format(Me.ListCards.Column(2), "Short Date") < Date Then
Option Compare Database
 
Private Sub CardFilter_Enter()
    Me.CardFilter.BackStyle = "1"
End Sub
 
Private Sub CardFilter_Exit(Cancel As Integer)
    If IsNull(Me.CardFilter) Or Me.CardFilter = "" Then
        Me.CardFilter.BackStyle = "0"
        Me.ListCards.RowSource = "SELECT Cards.CardNo, CardStatus.Status, Cards.* FROM CardStatus " & _
         "INNER JOIN Cards ON CardStatus.StatusID=Cards.StatusID WHERE (((Cards.StatusID)<>5)) " & _
         "ORDER BY Cards.CardNo;"
    Else
        Me.CardFilter.BackStyle = "1"
    End If
End Sub
 
Private Sub CardFilter_KeyPress(KeyAscii As Integer)
    Dim str As String
    If IsNull(Me.CardFilter) Then
        str = Me.CardFilter.Text
    Else
        str = str & Me.CardFilter.Text
    End If
    Me.ListCards.RowSource = "SELECT Cards.CardNo, CardStatus.Status, * FROM CardStatus " & _
     "INNER JOIN Cards ON CardStatus.StatusID=Cards.StatusID WHERE (((Cards.StatusID)<>5)) " & _
     "AND ((Cards.RemDate) Is Null) AND Cards.CardNo Like '*" & str & "*' ORDER BY Cards.CardNo;"
End Sub
 
Private Sub CmdAddNew_Click()
    Me.AddNew = -1
    Me.ListCards = 0
    Me.CardNo.Enabled = True
    Me.CardNo = ""
    Me.Expiration.Enabled = True
    Me.Expiration = ""
    Me.CmdCalendar.Enabled = True
    Me.StatusID.Enabled = True
    Me.StatusID = 1
    Me.StatusDate.Locked = True
    Me.StatusDate = Date
    Me.ListCards.Enabled = False
    Me.ListCards.ForeColor = 12632256
    Me.CardFilter.Enabled = False
    Me.CardNo.SetFocus
    Me.CmdAddNew.Enabled = False
    Me.CmdSave.Enabled = True
End Sub
 
Private Sub CmdCalendar_Click()
    DoCmd.OpenForm "FrmCalendar"
    Forms!FrmCalendar!Cldr = 1
End Sub
 
Private Sub CmdCancel_Click()
    If MsgBox("Are you sure you want to cancel this card and remove it from inventory?" & vbCrLf & vbCrLf & _
    "Note:  If removed, the card's history will be retained in the system, but the system will not allow any future transactions with this card.", vbYesNo, "Confirm Removal") = vbNo Then
        Me.StatusID = 1
        Exit Sub
    End If
    
    Dim rstRemove As DAO.Recordset
    Set rstRemove = CurrentDb.OpenRecordset("Select * from Cards Where [CardID] = " & Me.ListCards.Column(2), dbOpenDynaset, dbSeeChanges)
    With rstRemove
        .Edit
        !StatusID = 5
        !StatusDate = Date
        !RemDate = Date
        !Editby = Me.TxtUserName
        !EditDateTime = Now
        .Update
    End With
    
    DoCmd.Close , , acSaveYes
    
    If MsgBox("Fleet card changes have been saved.  Would you like to make additional fleet card changes?", vbYesNo, "Edit More Cards?") = vbYes Then
        DoCmd.OpenForm "FrmCards"
    End If
    
End Sub
 
Private Sub CmdSave_Click()
    If IsNull(Me.CardNo) Then
        MsgBox "Please enter the 16 digit card number.", , "Enter Card Number!"
        Exit Sub
    End If
    If IsNull(Me.Expiration) Then
        MsgBox "Please enter the card's expiration date.", , "No Expiration Date!"
        Exit Sub
    End If
    If IsNull(Me.StatusID) Or Me.StatusID = 0 Then
        MsgBox "Please select the card's status from the list.", , "No Status Selected!"
        Exit Sub
    End If
    
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("Cards", dbOpenDynaset, dbSeeChanges)
    
    If Me.AddNew = -1 Then
        With rst
            .AddNew
            !CardNo = Me.CardNo
            !Expiration = Me.Expiration
            !StatusID = Me.StatusID
            !StatusDate = Date
            !RecDate = Date
            !Editby = Me.TxtUserName
            !EditDateTime = Now
            .Update
        End With
    Else
        rst.Filter = "CardID = " & Me.ListCards.Value
        Set rst = rst.OpenRecordset
        
        With rst
            .Edit
            !CardNo = Me.CardNo
            !Expiration = Me.Expiration
            !StatusID = Me.StatusID
            If Me.StatusID <> i Then
                !StatusDate = Me.StatusDate
            End If
            If Me.StatusID = 5 Then
                !RemDate = Date
            End If
            !Editby = Me.TxtUserName
            !EditDateTime = Now
            .Update
        End With
    End If
    
    DoCmd.Close , , acSaveYes
    
    If MsgBox("Fleet card changes have been saved.  Would you like to make additional fleet card changes?", vbYesNo, "Edit More Cards?") = vbYes Then
        DoCmd.OpenForm "FrmCards"
    End If
 
End Sub
 
Private Sub Form_Load()
    Me.TxtUserName = Forms!FEMAMaster!TxtUserName
    Me.ListCards = ""
    Me.ListCards.RowSource = "SELECT Cards.CardNo, CardStatus.Status, Cards.* " & _
     "FROM CardStatus INNER JOIN Cards ON CardStatus.StatusID = Cards.StatusID WHERE " & _
     "(((Cards.StatusID)<>5) AND ((Cards.RemDate) Is Null)) ORDER BY Cards.CardNo;"
End Sub
 
Private Sub ListCards_AfterUpdate()
    Me.CmdCancel.Enabled = True
    Me.CardNo.Enabled = True
    Me.Expiration.Enabled = True
    Me.CmdCalendar.Enabled = True
    Me.StatusID.Enabled = True
    Me.StatusDate.Locked = True
    Me.CmdSave.Enabled = True
    
    Me.AddNew = 0
    Dim i As Integer
    i = Me.ListCards.Column(5)
    Me.CardNo.Enabled = True
    Me.CardNo = Me.ListCards
    Me.Expiration.Enabled = True
    Me.Expiration = Format(Me.ListCards.Column(4), "Short Date")
    Me.CmdCalendar.Enabled = True
    Me.StatusID.Enabled = True
    Me.StatusID = Me.ListCards.Column(5)
    Me.StatusDate.Locked = True
    Me.StatusDate = Format(Me.ListCards.Column(6), "Short Date")
 
    If Format(Me.ListCards.Column(2), "Short Date") < Date Then
        Me.Expiration.ForeColor = vbRed
        Me.Expiration.FontBold = True
        MsgBox "The Selected Card Has Expired!", , "CARD EXPIRED"
    Else
        Me.Expiration.ForeColor = vbBlack
        Me.Expiration.FontBold = False
    End If
End Sub
 
Private Sub StatusID_AfterUpdate()
    If Me.StatusID = 3 Then
        MsgBox "Lost, Missing or Stolen Cards Should be Reported by Calling 1-888-297-0782", , "REPORT MISSING CARD!"
    End If
    Me.StatusDate = Date
End Sub

Open in new window

Microsoft AccessProgramming Theory

Avatar of undefined
Last Comment
captgriggs

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Scott McDaniel (EE MVE )

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Rey Obrero (Capricorn1)

(I only get it on some entries.)

what are the entries thats giving the error?

ASKER
captgriggs

I increased the value from 2 to 4 and it seems to be ok. Thanks for the help.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck