Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

Troubleshooting
Research
Professional Opinions
Ask a Question
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

troubleshooting Question

Access 2003 runtime error 6 overflow

Avatar of captgriggs
captgriggs asked on
Microsoft AccessProgramming Theory
3 Comments1 Solution468 ViewsLast Modified:
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