Here is the code for the form, every control on the form is bound to the table named CLAIMS.
Option Compare Database
Option Explicit
Dim RetVal As Variant
Dim rs As DAO.Recordset
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Private Sub CARRIERCODE_AfterUpdate()
On Error GoTo Err_CARRIERCODE
'populate carrier name field
Dim db As DAO.Database
Dim rs As DAO.Recordset, qd As QueryDef
Set db = CurrentDb
Set qd = db.CreateQueryDef("")
qd.SQL = "Select CARRIERNAME from CARRIER where CARRIERCODE = '" & Trim(CARRIERCODE) & "'"
Set rs = qd.OpenRecordset(Dynaset)
If rs.RecordCount = 0 Then
MsgBox "Carrier code: '" & Trim(CARRIERCODE) & "' not found in the database."
Else
cmbCarrier = rs(0)
End If
Exit_CARRIERCODE:
Exit Sub
Err_CARRIERCODE:
If Err.Number <> 3251 Then
MsgBox Err.DESCRIPTION
Else
Resume Exit_CARRIERCODE
End If
End Sub
'Private Sub CARRIERFB_AfterUpdate()
'Me.cbmHAWB.Requery
'End Sub
Private Sub cmbCarrier_AfterUpdate()
CARRIERCODE = cmbCarrier.Column(0)
End Sub
Private Sub cmdClaimReport_Click()
Dim stDocName As String
On Error GoTo Err_cmdPrintEntry_Click
If Me.NewRecord And Not Me.Dirty Then
MsgBox "No information has been entered for this claim."
Exit Sub
End If
If IsNull(SENTDATE) Then
SENTDATE = Date
End If
If Me.Dirty Then
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
End If
strReportSource = "Select Carrier Claim"
stDocName = "Claims Report"
DoCmd.OpenReport stDocName, acNormal
Exit_cmdPrintEntry_Click:
Exit Sub
Err_cmdPrintEntry_Click:
If Err.Number <> 3251 Then
MsgBox Err.DESCRIPTION
Else
Resume Exit_cmdPrintEntry_Click
End If
End Sub
Private Sub cmdFileReport_Click()
On Error GoTo Err_cmdPrintEntry_Click
If Me.NewRecord And Not Me.Dirty Then
MsgBox "No information has been entered for this claim."
Exit Sub
End If
If Me.Dirty Then
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
End If
Dim stDocName As String
strReportSource = "Select File Claim"
stDocName = "File Report"
DoCmd.OpenReport stDocName, acNormal
Exit_cmdPrintEntry_Click:
Exit Sub
Err_cmdPrintEntry_Click:
If Err.Number <> 3251 Then
MsgBox Err.DESCRIPTION
Else
Resume Exit_cmdPrintEntry_Click
End If
End Sub
Private Sub Combo309_AfterUpdate()
On Error GoTo err_Update
If Me.DATECLOSED > 0 Then
Me.Label86.Caption = "Date Delivered"
Me.Label76.Caption = "Days In Transit"
Me.ACKNUMBER.VALUE = (Date - [SHIPDATE])
Else:
Label86.Caption = "Days to Deliver"
Label76.Caption = "Days In Transit"
Me.ACKNUMBER.VALUE = (SHIPDEPT - [DATECLOSED])
exit_sub:
Exit Sub
err_Update:
If Err <> 3251 Then
Exit Sub
Resume Next
MsgBox "Your changes were not saved."
' Cancel = True
Resume exit_sub
End If
End If
End Sub
Private Sub DATECLOSED_AfterUpdate()
If IsNull(DATECLOSED) Then
CLAIMSTATUS = "OPEN"
Else
CLAIMSTATUS = "CLOSED"
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
Call AuditTrail(Me, CLAIMENTRY)
On Error GoTo err_Update
Dim strClaimNo As String
MODDATE = Date
'check for required fields
If IsNull(Me!CARRIERCODE) Then
MsgBox "The carrier code is a required item."
Cancel = True
CARRIERCODE.SetFocus
Exit Sub
End If
If IsNull(Me!REPID) Then
'should never happen, but you never know...
MsgBox "This claim cannot be saved. The claim rep id is missing."
Cancel = True
Exit Sub
End If
' If IsNull(Me!SHIPDEPT) Then
' MsgBox "The SBU is a required item."
' Cancel = True
' SHIPDEPT.SetFocus
' Exit Sub
' End If
If IsNull(Me!CLAIMTYPE) Then
MsgBox "The claim type is a required item."
Cancel = True
CLAIMTYPE.SetFocus
Exit Sub
End If
'end of required data items.
exit_sub:
Exit Sub
Resume Next
err_Update:
If Err <> 3251 Then
MsgBox Err.DESCRIPTION
Else
MsgBox "Your changes were not saved."
Cancel = True
Resume exit_sub
End If
End Sub
Private Sub Form_Close()
DoCmd.SetWarnings True
RetVal = SysCmd(5)
DoCmd.Restore
Call LogDocClose(Me)
End Sub
Private Sub Form_Open(Cancel As Integer)
RetVal = SysCmd(4, "This is the form that contains all Air Freight, browse through the Freight with the navigation buttons at the bottom....")
Call LogDocOpen(Me)
'Dim AMOUNTCLOSED As Date
'If Forms![claims browse]![claims detail]![Claims.Browse]!AMOUNTCLOSED > 0 Then
'Me.Command283.Caption = "Preview Air Freight Report"
'Else:
'Me.Command283.Caption = "Preview Freight Report"
'End If
End Sub
Sub cmdUndo_Click()
On Error GoTo Err_cmdUndo_Click
If Me.Dirty Then
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
Else
MsgBox "There are no active edits to undo on this claim."
End If
Exit_cmdUndo_Click:
Exit Sub
Err_cmdUndo_Click:
If Err.Number <> 3251 Then
MsgBox Err.DESCRIPTION
Else
Resume Exit_cmdUndo_Click
End If
End Sub
Sub cmdMarkCancel_Click()
On Error GoTo Err_cmdMarkCancel_Click
Dim Response As Integer
'If Me.NewRecord Then
'If Me.Dirty Then
' Response = MsgBox("This claim has not yet been saved. Do you wish to cancel the changes you've made?", vbYesNo, "Confirm Undo")
' If Response = vbYes Then
' DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
' End If
' Else
' MsgBox "No information has been entered for this claim."
'End If
' Else
' Response = MsgBox("Please confirm that you wish to mark this claim as 'Cancelled.'", vbYesNo, "Confirm Status Change")
' If Response = vbYes Then
' Me!CLAIMSTATUS = "CANCELLED"
' End If
'End If
Exit_cmdMarkCancel_Click:
Exit Sub
Err_cmdMarkCancel_Click:
If Err.Number <> 3251 Then
MsgBox Err.DESCRIPTION
Else
Resume Exit_cmdMarkCancel_Click
End If
End Sub
Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click
' Dim Response As Integer
'If Me.Dirty Then
' Response = MsgBox("Changes have been made to this claim. Do you wish to save these changes?", vbYesNoCancel, "Save Changes?")
' If Response = vbNo Then
' DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
'ElseIf Response = vbCancel Then
' Exit Sub
' End If
' End If
DoCmd.Close
Call LogDocClose(Me)
Exit_cmdClose_Click:
Exit Sub
Err_cmdClose_Click:
If Err.Number <> 3251 Then
MsgBox Err.DESCRIPTION
Else
Resume Exit_cmdClose_Click
End If
End Sub
Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click
DoCmd.SetWarnings False
'If Me.Dirty Then
' DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
' MsgBox "Claim saved."
'Else
' If Me.NewRecord Then
' MsgBox "No information has been entered for this claim."
' Else
DoCmd.Save
MsgBox "Air Freight Report saved."
' Me.Refresh
' End If
'End If
Exit_cmdSave_Click:
Exit Sub
Err_cmdSave_Click:
If Err.Number <> 3251 Then
MsgBox Err.DESCRIPTION
Else
Resume Exit_cmdSave_Click
End If
DoCmd.SetWarnings True
End Sub
Private Sub Command282_Click()
DoCmd.OpenForm "Print Email", acNormal, , , , acDialog, 0
End Sub
Private Sub Command283_Click()
On Error GoTo Err_Command283_Click
Dim stDocName As String
'HERE
strReportSource = "Select File Claim"
'TO HERE
stDocName = "File Report"
DoCmd.OpenReport stDocName, acPreview
Exit_Command283_Click:
Exit Sub
Err_Command283_Click:
MsgBox Err.DESCRIPTION
Resume Exit_Command283_Click
End Sub
Private Sub NextRecord_Click()
On Error GoTo ErrHandler
If Recordset.EOF Then
Beep
MsgBox "You are at the end of records."
DoCmd.GoToRecord , , acFirst
Else
DoCmd.GoToRecord , , acNext
End If
'DoCmd.GoToRecord , Record:=acNext, Offset:=1
Retry:
Exit Sub
Resume Next
ErrHandler:
Select Case Err.Number
Case Is = "2501"
GoTo Retry
Case Else
MsgBox "Error number - " & Err.Number & vbCrLf & Err.DESCRIPTION
Sleep 5
GoTo Retry
Resume
End Select
End Sub
Private Sub PreviousRecord_Click()
On Error GoTo ErrHandler
If Recordset.BOF Then
Beep
MsgBox "You are at the beginning."
DoCmd.GoToRecord , , acNext
Else
DoCmd.GoToRecord , , acPrevious
End If
'DoCmd.GoToRecord , Record:=acPrevious, Offset:=1
Retry:
Exit Sub
Resume Next
ErrHandler:
Select Case Err.Number
Case Is = "2501"
GoTo Retry
Case Else
MsgBox "Error number - " & Err.Number & vbCrLf & Err.DESCRIPTION
Sleep 5
GoTo Retry
Resume
End Select
End Sub
Private Sub SUBCODE_AfterUpdate()
Me.Refresh
End Sub