Hi everyone. My VBA exports multiple queries (as determined by the user's selection on a form) to a new Excel workbook, with each query copied into its own worksheet.
The code works well, but with one problem. It screws up multivalued fields. (I know, I know, multivalued fields are terrible- but it's too late for me to change them.) For example, "Rifle, Shotgun" is displayed only as "Ri", and "Barbara England, Amy Stengel, Francine Gordon" is displayed as "27".
Any idea how I can change my exporting process to make it work right?
I suspect it can be done because when I open and export a query manually, it works fine as long as I select the "Export data with formatting and layout" option. So I guess my question is, how can I adjust my VBA procedure to do that?
The code is below. It's quite long, so I've bolded the parts that show the method I'm using to export the queries. Thanks very much for your help! -Matt
[code]
Private Sub ExportData_Click()
'Error Message if valid selection not made:
If ExportOptions <> 1 And ExportOptions <> 2 And ExportOptions <> 3 And _
ExportOptions <> 4 And ExportOptions <> 5 And ExportOptions <> 6 Then
Dim dResponse As Integer
dResponse = MsgBox("Please make a valid selection.", vbExclamation, "Error")
Exit Sub
End If
Dim MyDatabase As DAO.Database
Dim MyQueryDef As DAO.QueryDef
Dim MyRecordset As DAO.Recordset
Dim i As Integer
Dim strSQL As String
Dim SheetName As String
Dim QNumber As Integer
Dim QMax As Integer
Dim QName As String
'DEFINE QUERY:
Set MyDatabase = CurrentDb
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
On Error Resume Next
MyDatabase.QueryDefs.Delete "ExportToExcel" 'Deleting prior definition of query
On Error GoTo 0
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
strSQL = "SELECT " & QName & ".* FROM " & QName
Set MyQueryDef = MyDatabase.CreateQueryDef("ExportToExcel", strSQL) 'Defining Query
Set MyRecordset = MyQueryDef.OpenRecordset 'Open the query
'EXPORT TO EXCEL:
If QNumber = 1 Then
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.Workbooks.Add 'Open New Excel Workbook
On Error Resume Next
.Sheets("Sheet2").Select
.ActiveWindow.SelectedSheets.Delete
.Sheets("Sheet3").Select
.ActiveWindow.SelectedSheets.Delete
On Error GoTo 0
.Sheets("Sheet1").Select
End With
End If
With xlApp
If QNumber <> 1 Then
.Sheets.Add After:=.Sheets(.Sheets.Count)
End If
.ActiveSheet.Range("A2").CopyFromRecordset MyRecordset 'Copy the recordset to Excel
'FORMAT SPREADSHEET:
For i = 1 To MyRecordset.Fields.Count
xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i 'Add column heading names to the spreadsheet
.Rows("1:1").Select 'Format Headers
.Selection.Font.Bold = True
.Selection.Interior.Color = 14993882
.Columns("A:A").Select 'Format ID Numbers (1st Column)
.Selection.NumberFormat = "0.00"
.Cells.Select
.Selection.ColumnWidth = 60
.Selection.WrapText = True
.Cells.EntireColumn.AutoFit
.Selection.HorizontalAlignment = xlLeft
.Selection.VerticalAlignment = xlTop
.ActiveSheet.UsedRange.Borders.Weight = xlThin
.ActiveSheet.Name = SheetName
End With
'DELETE QUERY:
On Error Resume Next
MyDatabase.QueryDefs.Delete "ExportToExcel"
On Error GoTo 0
Next QNumber
xlApp.Sheets(1).Select
xlApp.Range("A1").Select
End Sub
[\code]