Access VBA

Make a Report Menu

Private Sub cmdSendRpts_Click()
    '01/07/2024     Generic Code to send reports where desired
    Dim RS          As Recordset
    Dim dB          As Database
    Dim SQLstr      As String
    Dim WritePath   As String
   
     DoCmd.RunCommand acCmdRefresh      ' updates data table before running query
   
    On Error GoTo cmdCloseRpt_Click_Err
    WritePath = KeyVal("DataPath")
    SQLstr = "SELECT tblReports2Print.ReportName, tblReports2Print.QueryName, tblReports2Print.Print,        tblReports2Print.DispoType" & vbCrLf
    SQLstr = SQLstr & " FROM tblReports2Print" & vbCrLf
    SQLstr = SQLstr & " WHERE (((tblReports2Print.Print) = True))" & vbCrLf
    SQLstr = SQLstr & " ORDER BY tblReports2Print.DispoType,  tblReports2Print.ReportName;"
 '   Debug.Print SQLstr
    Set dB = CurrentDb()
    Set RS = dB.OpenRecordset(SQLstr, dbOpenDynaset)
        RS.MoveFirst
        Do While Not RS.EOF
            Select Case RS!DispoType
                Case "Excel"
                    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, RS!QueryName, WritePath & RS!ReportName & "_" & _
                    Format(Now(), "yyyymmdd"), True
                '    MsgBox "Spreadsheet " & RS!ReportName & " sent to " & WritePath, vbOKOnly, "Spreadsheet sent"
                Case "On Screen"
                    DoCmd.OpenQuery RS!QueryName, acViewPreview
                Case "Print", "Report"
                    DoCmd.OpenReport RS!QueryName, acViewPreview
                Case "Text"
                    MsgBox "Open " & RS!QueryName & " in the " & WritePath & " directory using Notepad or Word", vbExclamation
                Case Else
                    MsgBox "Report an error to Alan for an unexpected output type", vbCritical
            End Select
          RS.MoveNext
        Loop
        MsgBox "All reports sent or on screen for action", vbOKOnly
cmdCloseRpt_Click_Exit:
    Exit Sub

cmdCloseRpt_Click_Err:
    MsgBox Error$
    Resume cmdCloseRpt_Click_Exit
End Sub