Private Sub ExportOverviewToExcel_Click()
'Variables to create Excel App
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
'Variables for data retrieval
Dim db As DAO.Database
Dim qdf1 As DAO.QueryDef
Dim SQL1 As String
Dim rs1 As DAO.Recordset
'Variables for spreadsheet population
Dim nrow, ncol As Integer
On Error GoTo SubError
DoCmd.Hourglass True
Set db = CurrentDb()
Set qdf1 = db.QueryDefs("QuerySQL1")
qdf1!ParEvent = [Forms]![EVENTOVERVIEW]![Event]
Set rs1 = qdf1.OpenRecordset
'Check there is data to export
If rs1.RecordCount = 0 Then
MsgBox "No data available for export", vbInformation + vbOKOnly, "Excel not launched"
GoTo SubExit
End If
Set xlApp = Excel.Application
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set xlSheet = xlWorkbook.Worksheets(1)
With xlSheet
'General formatting
.Name = "Event Summary"
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 10
.Cells.VerticalAlignment = xlCenter
.Columns.WrapText = True
.Columns.ColumnWidth = 20
'Position counter
nrow = 1
ncol = 1
'TITLES
.Rows(nrow).Font.Size = 14
.Rows(nrow).Font.Bold = True
.Rows(nrow).VerticalAlignment = xlCenter
.Rows(nrow).Interior.Color = RGB(255, 121, 121)
.Cells(nrow, 1) = "EVENT DETAILS"
'SUBTITLES
nrow = nrow + 2
.Rows(nrow).Font.Size = 12
.Rows(nrow).Font.Bold = True
.Rows(nrow).Interior.Color = RGB(248, 248, 248)
.Cells(nrow, ncol) = "Event"
.Columns(ncol).ColumnWidth = 30
ncol = ncol + 1
.Cells(nrow, ncol) = "Deadline"
.Columns(ncol).HorizontalAlignment = xlCenter
'DATA FILLING
.Range("A5").CopyFromRecordset rs1
End With
xlApp.Visible = True
MsgBox "File exported successfully", vbInformation + vbOKOnly, "Export success"
SubExit:
DoCmd.Hourglass False
On Error Resume Next
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing
Set db = Nothing
Set rs1 = Nothing
Set qdf1 = Nothing
rst1.Close
qdf1.Close
Exit Sub
SubError:
MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
Err.Clear
Resume SubExit
End Sub