Code Problems (1 Viewer)

Dim ReportName As String
Dim ReportDate As String
Dim FileName As String

ReportName = "Report ("
ReportDate = Me.txtMonth & "-" & Me.txtDay & "-" & Me.txtYear & ")"
    
FileName = ReportName & ReportDate
    
Dim sngStart As Variant
Dim sngEnd As Variant
Dim sngElapsed As Variant

‘Get Start Time
sngStart = Timer
stDocName = "rptNewCoatingLetter"

DoCmd.OutputTo acOutputReport, stDocName, "SnapshotFormat(*.snp)",_
[b]Left[/b](CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))_
& "Notification Letters\" & FileName & ".snp", True    

‘Get end time.
sngEnd = Timer

' Elapsed time.
sngElapsed = [b]Format[/b](sngEnd - sngStart, "Fixed")

Sub FixUpRefs()
    Dim loRef As Access.Reference
    Dim intCount As Integer
    Dim intX As Integer
    Dim blnBroke As Boolean
    Dim strPath As String

    On Error Resume Next

    'Count the number of references in the database
    intCount = Access.References.Count
  
    'Loop through each reference in the database
    'and determine if the reference is broken.
    'If it is broken, remove the Reference and add it back.
    For intX = intCount To 1 Step -1
      Set loRef = Access.References(intX)
      With loRef
        blnBroke = .IsBroken
        If blnBroke = True Or Err <> 0 Then
          strPath = .FullPath
          With Access.References
            .Remove loRef
            .AddFromFile strPath
          End With
        End If
       End With
    Next
    
  Set loRef = Nothing
  
  ' Call a hidden SysCmd to automatically compile/save all modules.
  Call SysCmd(504, 16483)
End Sub

    Sub ReferenceInfo()
      Dim strMessage As String
      Dim strTitle As String
      Dim bytButtons As Byte
      Dim refItem As Reference

      On Error Resume Next

      For Each refItem In References
         If refItem.IsBroken Then
            strTitle = "MISSING Reference"
            strMessage = "Missing Reference:" & vbCrLf & refItem.FullPath
            bytButtons = 16 'critical symbol
         Else
            strTitle = "Displaying References and Their Locations"
            strMessage = "Reference: " & refItem.Name & vbCrLf & _
            "Location: " & refItem.FullPath
            bytButtons = 64 'information symbol
        End If

      MsgBox prompt:=strMessage, Title:=strTitle, buttons:=bytButtons

      Next refItem

    End Sub

Private Sub SetRefs_Click() 
Dim ref As Reference 
Dim intRef As Integer 
Dim ErrorMsg As String 

On Error GoTo ErrHandler 

intRef = 1 
Set ref = References.AddFromFile("C:\Program Files\Common Files\_
MicroSoft Shared\VBA\VBA332.DLL") 

intRef = 2 
Set ref = References.AddFromFile("C:\Program Files\MicroSoft Office\_
Office\MSACC8.OLB") 

intRef = 3 
Set ref = References.AddFromFile("C:\Program Files\MicroSoft Office\_
Office\MSO97.OLB") 

intRef = 4 
Set ref = References.AddFromFile("C:\Program Files\Common Files\_
MicroSoft Shared\DAO\DAO360.DLL") 

intRef = 5 
Set ref = References.AddFromFile("C:\Program Files\MicroSoft Office\_
Office\MSPRJ9.OLB") 

intRef = 6 
Set ref = References.AddFromFile("C:\Program Files\MicroSoft Office\_
Office\EXCEL8.OLB") 

Exit Sub 

ErrHandler: 
Select Case intRef 
Case 1 
ErrorMsg = "No VBA332" 
Case 2 
ErrorMsg = "No DAO360" 
Case 3 
ErrorMsg = "No MSACC8" 
Case 4 
ErrorMsg = "No MS097" 
Case 5 
ErrorMsg = "No MSPRJ9" 
Case 6 
ErrorMsg = "No EXCEL8" 
End Select 

MsgBox (ErrorMsg) 

End Sub