Categorised Menu List

Export Data from Ms.Access Table

The data derieved from the query, which inturn draws data fom table.

 

Uses DoCmd method.

  1. DoCmd.OutputTo
  2. DoCmd.SendObject
  3. DoCmd.OpenReport and 
  4. Error Handler towards the end of the code.

The following code is used to export a table from Ms.Access to Excel and mail respective end users of the data.

 

For this purpose, seperate queries are designed so that the original tables are kept undisturbed.

 

A command button cmdExport is placed in Ms.Access User form to execute.

EXPORT DATA FROM ACCESS TABLE 

SENDS MAIL TO RESPECTIVE STAKEHOLDERS

Private Sub cmdExport_Click()
'On Error GoTo errHandler

Dim strReport As String, strSubject As String
Dim rtn As Integer

strSubject = "Dear All " & vbCrLf & vbNewLine & _
                    "Please find the report as mentioned in the subject drawn at " & Now() & vbCrLf & vbNewLine & _
                    "Regards " & vbCrLf & _
                    "abc Collections Team" & vcbrlf & vbNewLine & vbNewLine & _
                    "Please note: This is an automated e-mail sent from the Collections database tool."

    strReport = Me.cmbReports.Value
    If strReport <> "Export All" Then
        rtn = MsgBox(" Do you want to export the report to Excel or View onscreen...? " & vbCrLf & vbNewLine & _
        "Press YES to export, " & vbCrLf & "Press NO to view and," & vbCrLf & "Press CANCEL to cancel this operation ", vbYesNoCancel + vbQuestion + vbDefaultButton1, "Export/View...")
    End If
    
    Select Case strReport
        Case "Accounts Coverage"
            If rtn = vbYes Then
                DoCmd.OutputTo acOutputQuery, "qryAccountCoverage", acFormatXLS, Application.CurrentProject.Path & "\qryabc_AccountCoverage" & Format(Now, "ddmmmyyyy_hhmmss") & ".xls", False
                DoCmd.SendObject acSendQuery, "qryAccountCoverage", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_AccountCoverage" & Format(Now, "ddmmmyyyy_hhmmss"), strSubject, 0
            ElseIf rtn = vbNo Then
                DoCmd.OpenReport "rptAccountCoverage", acViewPreview
                Exit Sub
            ElseIf rtn = vbCancel Then
                Exit Sub
            End If
        
        Case "Disputes"
            If rtn = vbYes Then
                DoCmd.OutputTo acOutputQuery, "qryDisputes", acFormatXLS, Application.CurrentProject.Path & "\qryabc_Disputes" & Format(Now, "ddmmmyyyy_hhmmss") & ".xls", False
                DoCmd.SendObject acSendQuery, "qryDisputes", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_Disputes" & Format(Now, "ddmmmyyyy_hhmmss"), strSubject, 0
                'DoCmd.SendObject acSendQuery, "qryDisputes", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", _
                "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_Disputes", strSubject, 0
            ElseIf rtn = vbNo Then
                DoCmd.OpenReport "rptDisputes", acViewPreview
                Exit Sub
            ElseIf rtn = vbCancel Then
                Exit Sub
            End If
        
        Case "Resolution"
            If rtn = vbYes Then
               DoCmd.OutputTo acOutputQuery, "qryResolution", acFormatXLS, Application.CurrentProject.Path & "\qryabc_Resolution" & Format(Now, "ddmmmyyyy_hhmmss") & ".xls", False
               DoCmd.SendObject acSendQuery, "qryResolution", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_Resolution" & Format(Now, "ddmmmyyyy_hhmmss"), strSubject, 0
                
                'DoCmd.SendObject acSendQuery, "qryResolution", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", _
                "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_Resolution", strSubject, 0
            
            ElseIf rtn = vbNo Then
                DoCmd.OpenReport "rptResolution", acViewPreview
                Exit Sub
            ElseIf rtn = vbCancel Then
                Exit Sub
            End If
        
        Case "Time Spent"
             If rtn = vbYes Then
               DoCmd.OutputTo acOutputQuery, "qryTimeSpent", acFormatXLS, Application.CurrentProject.Path & "\qryabc_TimeSpent" & Format(Now, "ddmmmyyyy_hhmmss") & ".xls", False
               DoCmd.SendObject acSendQuery, "qryTimeSpent", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_TimeSpent" & Format(Now, "ddmmmyyyy_hhmmss"), strSubject, 0
                
                'DoCmd.SendObject acSendQuery, "qryTimeSpent", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", _
                "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_TimeSpent", strSubject, 0
             ElseIf rtn = vbNo Then
                DoCmd.OpenReport "rptTimeSpent", acViewPreview
                Exit Sub
            ElseIf rtn = vbCancel Then
                Exit Sub
            End If
       
        Case "Export All"
            DoCmd.OutputTo acOutputQuery, "qryMain", acFormatXLS, Application.CurrentProject.Path & "\qryabc_Dump" & Format(Now, "ddmmmyyyy_hhmmss") & ".xls", False
            DoCmd.SendObject acSendQuery, "qryMain", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_Dump" & Format(Now, "ddmmmyyyy_hhmmss"), strSubject, 0
            
            'DoCmd.SendObject acSendQuery, "qryMain", acFormatXLS, "radha@abc_company.info;hari@abc_company.info", _
                "amit@abc_company.info;pooja@xyz_company.info", , "qryabc_Dump", strSubject, 0
        End Select
    
errHandler:
    Select Case Err.Number
        Case 0
            MsgBox "File Succesfully exported to default file location: " & vbCrLf & "Location: " & Application.CurrentProject.Path, vbInformation + vbOKOnly, "Export Complete..."
        Case 2501
            Exit Sub
        Case Else
            MsgBox Err.Number & " " & Err.Description & vbCrLf & _
            "Contact Admin for further assistance", vbOKOnly, "Export Error..."
            Exit Sub
        End Select
End Sub

Issues you may encounter: While you copy and paste the code from here to code window, replace double quotes in code window again, as these quotes will appear as smart quotes.

 

Original Code, Company names and user names are replaced with false names.

Code file in .txt format

It is always advisable to make best use of status bar.  Application.StatusBar = "some text"

This will help end user to know that the work is in progress...