I have a form where the user selects a report, Presenter Data Report, from a combo-box on a form. The user then clicks a button that executes the following code to export the query to a formatted Excel file:
Code:
Private Sub Command7_Click()
If Combo5 = "Presenter Data Report" Then
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim rst As DAO.Recordset
'Start a new workbook in Excel
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
Set oBook = oExcel.Workbooks.Add
Set rst = CurrentDb.OpenRecordset("PresenterDataReport2_Query")
'Add data to cells of the first worksheet in the new workbook
Set oSheet = oBook.Worksheets(1)
oSheet.Range("A1:AH1").Font.Bold = True
oSheet.Range("A1").Value = "PM"
oSheet.Range("B1").Value = "Session Number"
oSheet.Range("C1").Value = "Session Title"
oSheet.Range("D1").Value = "Session Date"
oSheet.Range("E1").Value = "Start Time"
oSheet.Range("F1").Value = "End Time"
oSheet.Range("G1").Value = "Repeat Date"
oSheet.Range("H1").Value = "Repeat Start Time"
oSheet.Range("I1").Value = "Repeat End Time"
oSheet.Range("J1").Value = "Faculty Name"
oSheet.Range("K1").Value = "Last Name"
oSheet.Range("L1").Value = "Roles"
oSheet.Range("M1").Value = "Salutation"
oSheet.Range("N1").Value = "Email"
oSheet.Range("O1").Value = "Primary Position"
oSheet.Range("P1").Value = "Primary Employer"
oSheet.Range("Q1").Value = "Employer City"
oSheet.Range("R1").Value = "Employer State"
oSheet.Range("S1").Value = "Employer Province"
oSheet.Range("T1").Value = "Employer Country"
oSheet.Range("U1").Value = "Biography"
oSheet.Range("V1").Value = "Business Phone"
oSheet.Range("W1").Value = "Home Phone"
oSheet.Range("X1").Value = "Cell Phone"
oSheet.Range("Y1").Value = "Address Type"
oSheet.Range("Z1").Value = "Business Address Line"
oSheet.Range("AA1").Value = "Address 1"
oSheet.Range("AB1").Value = "Address 2"
oSheet.Range("AC1").Value = "City"
oSheet.Range("AD1").Value = "State"
oSheet.Range("AE1").Value = "Zip"
oSheet.Range("AF1").Value = "Complimentary Registration"
oSheet.Range("AG1").Value = "Honorarium"
oSheet.Range("AH1").Value = "Expenses"
oSheet.Columns("D:D").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
oSheet.Columns("G:G").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
oSheet.Columns("E:F").NumberFormat = "[$-409]h:mm AM/PM;@"
oSheet.Columns("H:I").NumberFormat = "[$-409]h:mm AM/PM;@"
oSheet.Columns("V:X").NumberFormat = "[<=9999999]###-####;(###) ###-####"
oSheet.Columns("AG:AH").NumberFormat = "$#,##0"
oSheet.Columns.Autofit
oSheet.Cells.WrapText = True
oSheet.Rows.RowHeight = 30
oSheet.Rows("1:1").RowHeight = 15
oSheet.Columns("A:A").ColumnWidth = 5
oSheet.Columns("B:B").ColumnWidth = 15
oSheet.Columns("C:C").ColumnWidth = 30
oSheet.Columns("D:D").ColumnWidth = 30
oSheet.Columns("G:G").ColumnWidth = 30
oSheet.Columns("J:J").ColumnWidth = 35
oSheet.Columns("K:K").ColumnWidth = 15
oSheet.Columns("L:L").ColumnWidth = 25
oSheet.Columns("N:N").ColumnWidth = 35
oSheet.Columns("O:O").ColumnWidth = 35
oSheet.Columns("P:P").ColumnWidth = 35
oSheet.Columns("U:U").ColumnWidth = 35
oSheet.Columns("Z:Z").ColumnWidth = 35
oSheet.Columns("AA:AA").ColumnWidth = 25
oSheet.Columns("AB:AB").ColumnWidth = 25
oSheet.Columns("V:X").ColumnWidth = 15
oSheet.Columns("AC:AC").ColumnWidth = 15
oSheet.Columns("AE:AE").ColumnWidth = 10
lngCount = 1
Do Until rst.EOF
With oSheet
.Cells(lngCount + 1, 1).Value = rst!PM
.Cells(lngCount + 1, 2).Value = rst!SessionNum
.Cells(lngCount + 1, 3).Value = rst!SessionTitle
.Cells(lngCount + 1, 4).Value = rst!Date
.Cells(lngCount + 1, 5).Value = rst!StartTime
.Cells(lngCount + 1, 6).Value = rst!EndTime
.Cells(lngCount + 1, 7).Value = rst!Repeat_Date
.Cells(lngCount + 1, 8).Value = rst!Repeat_StartTime
.Cells(lngCount + 1, 9).Value = rst!Repeat_EndTime
.Cells(lngCount + 1, 10).Value = rst!FullName_Credentials
.Cells(lngCount + 1, 11).Value = rst!LastName
.Cells(lngCount + 1, 12).Value = rst!Roles
.Cells(lngCount + 1, 13).Value = rst!Salutation
.Cells(lngCount + 1, 14).Value = rst!Email
.Cells(lngCount + 1, 15).Value = rst!Primary_Position
.Cells(lngCount + 1, 16).Value = rst!Primary_Employer
.Cells(lngCount + 1, 17).Value = rst!Employer_City
.Cells(lngCount + 1, 18).Value = rst!Employer_State
.Cells(lngCount + 1, 19).Value = rst!Employer_Province
.Cells(lngCount + 1, 20).Value = rst!Employer_Country
.Cells(lngCount + 1, 21).Value = rst!Bio
.Cells(lngCount + 1, 22).Value = rst!BusinessPhone_Value
.Cells(lngCount + 1, 23).Value = rst!HomePhone_Value
.Cells(lngCount + 1, 24).Value = rst!CellPhone_Value
.Cells(lngCount + 1, 25).Value = rst!AddressType_Text
.Cells(lngCount + 1, 26).Value = rst!Business_Name
.Cells(lngCount + 1, 27).Value = rst!Address_1
.Cells(lngCount + 1, 28).Value = rst!Address_2
.Cells(lngCount + 1, 29).Value = rst!City
.Cells(lngCount + 1, 30).Value = rst!State
.Cells(lngCount + 1, 31).Value = rst!Zip
.Cells(lngCount + 1, 32).Value = rst!CompReg_Text
.Cells(lngCount + 1, 33).Value = rst!Honorarium
.Cells(lngCount + 1, 34).Value = rst!Expenses
End With
lngCount = lngCount + 1
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End If
End Sub
This works perfectly. However, I have a second combo fox to apply a filter (criteria) to the query so that the resulting Excel spreadsheet only contains records according to the selection in the combo box. I cannot get it to work. I keep getting an error message. How do I get this to work??