Code:
Private Sub ExportData_Click()
'ERROR MSG IF NO VALID SELECTION:
If ExportOptions <> 1 And ExportOptions <> 2 And ExportOptions <> 3 And _
ExportOptions <> 4 And ExportOptions <> 5 And ExportOptions <> 6 Then
MsgBox "Please make a valid selection.", vbExclamation, "Error"
Exit Sub
End If
'DEFINE VARIABLES:
Dim xlApp As Object
Dim ShortBookName As String
Dim FullBookName As String
Dim BookPath As String
Dim DummyBookFull As String
Dim DummyBookShort As String
Dim SaveSelection As Integer
Dim objList As Object, objType As Object, strObj$
Dim i As Integer
Dim SheetName As String
Dim QNumber As Integer
Dim QMax As Integer
Dim QName As String
'CHECK IF EXCEL IS ALREADY OPEN:
strObj = "Excel.exe"
Set objType = GetObject("winmgmts:").ExecQuery("select * from win32_process where name='" & strObj & "'")
If objType.Count > 0 Then
MsgBox "Please close Excel prior to exporting data.", vbExclamation, "Error"
Exit Sub
Else
Set xlApp = CreateObject("Excel.Application")
End If
'ADD AND SAVE A NEW WORKBOOK:
xlApp.Visible = False
xlApp.Workbooks.Add
SaveSelection = xlApp.Application.FileDialog(msoFileDialogSaveAs).Show
'GRAB THE FILE NAME AND PATH:
If SaveSelection <> 0 Then
FullBookName = xlApp.Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
End If
Debug.Print FullBookName
xlApp.ActiveWorkbook.SaveAs FileName:=FullBookName
ShortBookName = Right(FullBookName, Len(FullBookName) - InStrRev(FullBookName, "\"))
Debug.Print ShortBookName
BookPath = xlApp.ActiveWorkbook.Path
Debug.Print BookPath
DummyBookFull = BookPath & "\DummyWorkbook-" & ShortBookName
Debug.Print DummyBookFull
DummyBookShort = "DummyWorkbook-" & ShortBookName
Debug.Print DummyBookShort
'DEFINE QUERIES & NAME SHEETS:
QMax = Switch(ExportOptions = 1, 3, _
ExportOptions = 2, 9, _
ExportOptions = 3, 3, _
ExportOptions = 4, 6, _
ExportOptions = 5, 3, _
ExportOptions = 6, 24)
For QNumber = 1 To QMax
If ExportOptions = 1 Then
QName = Switch(QNumber = 1, "qryExportIncidentDetails", _
QNumber = 2, "qryExportComplaintInfo", _
QNumber = 3, "qryExportEventInfo")
SheetName = Switch(QNumber = 1, "Incident Details", _
QNumber = 2, "Complaint Info", _
QNumber = 3, "Event Info")
End If
If ExportOptions = 2 Then
QName = Switch(QNumber = 1, "qryExportVictimPerps", _
QNumber = 2, "qryExportDemographicInfo", _
QNumber = 3, "qryExportFatalityandInjury", _
QNumber = 4, "qryExportCriminalHistory", _
QNumber = 5, "qryExportSAMH", _
QNumber = 6, "qryExportInjunctionHistory", _
QNumber = 7, "qryExportServices", _
QNumber = 8, "qryExportVictimQuestions", _
QNumber = 9, "qryExportPerpQuestions")
SheetName = Switch(QNumber = 1, "Victims + Perps", _
QNumber = 2, "Demographic Info", _
QNumber = 3, "Injuries + Fatalities", _
QNumber = 4, "Criminal History", _
QNumber = 5, "Drug Abuse + Mental Health", _
QNumber = 6, "Injunction History", _
QNumber = 7, "Services Requested", _
QNumber = 8, "Additional Victim Qs", _
QNumber = 9, "Additional Perp Qs")
End If
If ExportOptions = 3 Then
QName = Switch(QNumber = 1, "qryExportRelationships", _
QNumber = 2, "qryExportRelationshipInfo", _
QNumber = 3, "qryExportCustody")
SheetName = Switch(QNumber = 1, "Relationships", _
QNumber = 2, "Relationship Info", _
QNumber = 3, "Custody Info")
End If
If ExportOptions = 4 Then
QName = Switch(QNumber = 1, "qryExportMeetingInfo", _
QNumber = 2, "qryExportTimeline", _
QNumber = 3, "qryExportRedFlags", _
QNumber = 4, "qryExportAgencyInvolvement", _
QNumber = 5, "qryExportAdditionalQuestions", _
QNumber = 6, "qryExportRecommendations")
SheetName = Switch(QNumber = 1, "Meeting Info", _
QNumber = 2, "Timeline", _
QNumber = 3, "Red Flags", _
QNumber = 4, "Agency Involvement", _
QNumber = 5, "AdditionalQs", _
QNumber = 6, "Recommendations")
End If
If ExportOptions = 5 Then
QName = Switch(QNumber = 1, "qryExportContributors", _
QNumber = 2, "qryExportWitnesses", _
QNumber = 3, "qryExportDocuments")
SheetName = Switch(QNumber = 1, "Contributors", _
QNumber = 2, "Witnesses", _
QNumber = 3, "Documents")
End If
If ExportOptions = 6 Then
QName = Switch(QNumber = 1, "qryExportIncidentDetails", _
QNumber = 2, "qryExportComplaintInfo", _
QNumber = 3, "qryExportEventInfo", _
QNumber = 4, "qryExportVictimPerps", _
QNumber = 5, "qryExportDemographicInfo", _
QNumber = 6, "qryExportFatalityandInjury", _
QNumber = 7, "qryExportCriminalHistory", _
QNumber = 8, "qryExportSAMH", _
QNumber = 9, "qryExportInjunctionHistory", _
QNumber = 10, "qryExportServices", _
QNumber = 11, "qryExportVictimQuestions", _
QNumber = 12, "qryExportPerpQuestions", _
QNumber = 13, "qryExportRelationships", _
QNumber = 14, "qryExportRelationshipInfo", _
QNumber = 15, "qryExportCustody", _
QNumber = 16, "qryExportMeetingInfo", _
QNumber = 17, "qryExportTimeline", _
QNumber = 18, "qryExportRedFlags", _
QNumber = 19, "qryExportAgencyInvolvement", _
QNumber = 20, "qryExportAdditionalQuestions", _
QNumber = 21, "qryExportRecommendations", _
QNumber = 22, "qryExportContributors", _
QNumber = 23, "qryExportWitnesses", _
QNumber = 24, "qryExportDocuments")
SheetName = Switch(QNumber = 1, "Incident Details", _
QNumber = 2, "Complaint Info", _
QNumber = 3, "Event Info", _
QNumber = 4, "Victims + Perps", _
QNumber = 5, "Demographic Info", _
QNumber = 6, "Injuries + Fatalities", _
QNumber = 7, "Criminal History", _
QNumber = 8, "Drug Abuse + Mental Health", _
QNumber = 9, "Injunction History", _
QNumber = 10, "Services Requested", _
QNumber = 11, "Additional Victim Qs", _
QNumber = 12, "Additional Perp Qs", _
QNumber = 13, "Relationships", _
QNumber = 14, "Relationship Info", _
QNumber = 15, "Custody Info", _
QNumber = 16, "Meeting Info", _
QNumber = 17, "Timeline", _
QNumber = 18, "Red Flags", _
QNumber = 19, "Agency Involvement", _
QNumber = 20, "AdditionalQs", _
QNumber = 21, "Recommendations", _
QNumber = 22, "Contributors", _
QNumber = 23, "Witnesses", _
QNumber = 24, "Documents")
End If
'EXPORT THE QUERIES:
DoCmd.OutputTo acOutputQuery, QName, acFormatXLSX, DummyBookFull, False
With xlApp
.Workbooks.Open DummyBookFull
.ActiveSheet.Move After:=Workbooks(ShortBookName).Sheets(QNumber)
.ActiveSheet.Name = SheetName
.Rows("1:1").Select
.Selection.WrapText = True
End With
Kill DummyBookFull
Next QNumber
'SAVE AND CLOSE:
With xlApp
On Error Resume Next
.Sheets("Sheet1").Select
.ActiveWindow.SelectedSheets.Delete
.Sheets("Sheet2").Select
.ActiveWindow.SelectedSheets.Delete
.Sheets("Sheet3").Select
.ActiveWindow.SelectedSheets.Delete
On Error GoTo 0
.Sheets(1).Select
.Range("A1").Select
.ActiveWorkbook.Save
.Quit
End With
Set xlApp = Nothing
Set objList = Nothing
Set objType = Nothing
'REOPEN:
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Open FullBookName
Set xlApp = Nothing
End
End Sub