Difference makes the DIFFERENCE
Consulting - Quality
Categorised Menu List
Export Data from Ms.Access Table
The data derieved from the query, which inturn draws data fom table.
Uses DoCmd method.
- DoCmd.OutputTo
- DoCmd.SendObject
- DoCmd.OpenReport and
- 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.
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...