Solved Export report to Excel with VBA (1 Viewer)

Cris VS

Member
Local time
Today, 15:16
Joined
Sep 16, 2021
Messages
75
Hello all,

I am getting started with exports using VBA and I am having trouble finding documentation "for beginners" where it explains step by step how to export a report to Excel and how to format it, as the default Export that Access offers does not fit the needs of my project.

More specifically, in my database I have registered a list of events that contain different items and I have managed to create a report that shows the information related to the event on which I click (I linked the report with the field that gets clicked on with a Macro code that I found on Microsoft Support's site).

I would like to export this report to Excel, so that I can have one Excel document for each event.

Thank you very much
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 22:16
Joined
May 7, 2009
Messages
19,175
some Formatting on report may Not come Out when you export to excel.
to export report use DoCmd.Outputto (google).
 

Cris VS

Member
Local time
Today, 15:16
Joined
Sep 16, 2021
Messages
75
some Formatting on report may Not come Out when you export to excel.
to export report use DoCmd.Outputto (google).
This is the code I have at the moment:

Private Sub ExportOverview_Click()
On Error GoTo SubError
DoCmd.OutputTo acOutputReport, "EventSummary", acFormatXLS, "\\path\Events archive\" & [Event] & ".xls"
MsgBox "File exported succesfully", vbInformation + vbOKOnly, "Export success"
SubExit:
Exit Sub
SubError:
MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, "An error occurred"
GoTo SubExit
End Sub


The problem I have is that it records in Excel all the events with their information instead of just the event that is shown in the report: I get one document with the name of the event I selected but the information is a list of all the events, one after the other.

Regarding the formatting, I just want to choose the cells in which each piece of information should be recorded and maybe some formatting for headers and borders.

Thanks a lot
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 22:16
Joined
May 7, 2009
Messages
19,175
you need to Open the Report (with filter and hidden) first.

Private Sub ExportOverview_Click()
On Error GoTo SubError
docmd.OpenReport "EventSummary",acViewPreview,, "[eventID]=" & me.eventid, acHidden
DoCmd.OutputTo acOutputReport, "EventSummary", acFormatXLS, "\\path\Events archive\" & [Event] & ".xls"
MsgBox "File exported succesfully", vbInformation + vbOKOnly, "Export success"
DoCmd.Close acReport, "EventSummary"
SubExit:
Exit Sub
SubError:
MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, "An error occurred"
GoTo SubExit
End Sub
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 14:16
Joined
Jul 9, 2003
Messages
16,245
I see that you have your question answered.

I'm posting a link to some VBA code for anyone else who sees your question because I have found it very helpful in some products I have developed.

I believe the code is from a former member here "Bob Larson" and is currently held on the BTAB Developments site website here:-

 

Cris VS

Member
Local time
Today, 15:16
Joined
Sep 16, 2021
Messages
75
I see that you have your question answered.

I'm posting a link to some VBA code for anyone else who sees your question because I have found it very helpful in some products I have developed.

I believe the code is from a former member here "Bob Larson" and is currently held on the BTAB Developments site website here:-

Thanks. I am still having trouble to format the Excel once it is created. Do you know how can I adapt this code that you shared to modify my Excel?
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 14:16
Joined
Jul 9, 2003
Messages
16,245
Do you know how can I adapt this code that you shared to modify my Excel?

I answered a question on Access World Forums (AWF) using the code, and I made a blog about it on my website here:-


The blog includes a sample of the solution which is hosted on Gumroad.
 
Last edited:

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 14:16
Joined
Jul 9, 2003
Messages
16,245
This is a link to an article by Doug Steele where Doug explains what you can do with VBA and Excel in great detail:-


The link is also at the bottom of my blog....
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 10:16
Joined
Feb 19, 2002
Messages
42,983
Rather than opening the report, you can simply move the criteria to the Report's RecordSource.
 

Isaac

Lifelong Learner
Local time
Today, 07:16
Joined
Mar 14, 2017
Messages
8,738
@Cris VS

A few years ago I was working on a project where I constantly was writing code to output Access data to Excel.
I realized that in 90% of these cases, I wanted to do the same things to the resulting Excel file, stuff like:

1) Bold headers, specific fonts
2) Column autofit - but then shrink super wide ones back to ~50
3) Freeze top row
4) Re-name tab

So I wrote a procedure that was re-usable. This is a good idea to do every time you identify something that you're going to have to do > once, like this, write code you can re-use as a function or sub with parameters.

I dug into my archives and found this that I used to use. Hope it helps or gives some ideas :)

Code:
Sub FormatExcelOutput(strExcelPath As String, lngWorksheetPos As Long, blLeaveOpen As Boolean)
On Error GoTo errhandler
Dim newapp As Object
Dim wb As Object
Dim rng As Object
Dim ws As Object
Dim lngLastCol As Long
Dim x As Long
Set newapp = CreateObject("excel.application")
Set wb = newapp.workbooks.Open(strExcelPath)
Set ws = wb.sheets(lngWorksheetPos)
ws.Cells.wraptext = False
ws.rows(1).Font.Bold = True
ws.PageSetup.Orientation = 2
ws.PageSetup.Zoom = False
ws.PageSetup.FitToPagesTall = False
ws.PageSetup.FitToPagesWide = 1
ws.Columns.AutoFit
lngLastCol = ws.Cells(1, ws.Columns.Count).End(-4159).Column
For x = 1 To lngLastCol - 1
    If ws.Columns(x).ColumnWidth > 35 Then  'reduce and wrap
        ws.Columns(x).ColumnWidth = 35
        ws.Columns(x).wraptext = True
    End If
Next x

For Each rng In ws.usedrange
    'this change was required due to jessica's request that i change the commission fields to text ...
    'apparently IsDate() thinks that "2.5" is a date.  Ridiculous on the part of VBA, but also a very reckless
    'change requested by the client.. Fortunately we were able to fix this one, I notified Susan of my stance on the issue
    'and I suggest next time we not re-purpose an existing field with already data.
    If IsDate(rng) And IsNumeric(rng) = False Then
    'If IsDate(rng) Then
        rng = Format(rng, "mm/dd/yyyy")
        rng.numberformat = "mm/dd/yyyy;@"
    End If
    rng.HorizontalAlignment = -4131
Next rng

With ws.PageSetup
    .PrintTitleRows = "$1:$1"
    .PrintTitleColumns = ""
End With
With ws.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .PrintHeadings = False
    .PrintGridlines = True
    '.PrintQuality = 600
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = 2
    .Draft = False
    .BlackAndWhite = False
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = False
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
    .EvenPage.LeftHeader.Text = ""
    .EvenPage.CenterHeader.Text = ""
    .EvenPage.RightHeader.Text = ""
    .EvenPage.LeftFooter.Text = ""
    .EvenPage.CenterFooter.Text = ""
    .EvenPage.RightFooter.Text = ""
    .FirstPage.LeftHeader.Text = ""
    .FirstPage.CenterHeader.Text = ""
    .FirstPage.RightHeader.Text = ""
    .FirstPage.LeftFooter.Text = ""
    .FirstPage.CenterFooter.Text = ""
    .FirstPage.RightFooter.Text = ""
End With

If blLeaveOpen = True Then
    wb.Save
    newapp.Visible = True
Else
    wb.Close (True)
    newapp.DisplayAlerts = False
    newapp.Quit
End If


Exit Sub
errhandler:
'AnyProgressLabelFormName.Visible=False
MsgBox "The following error has occurred in the function 'FormatExcelOutput': " _
& vbNewLine & vbNewLine & "If reporting this error, please STOP and " _
& "include a screenshot of this error" _
& vbNewLine & "as well as the entire screen/program" _
& vbNewLine & vbNewLine & "Error description:  " & Err.Description _
& vbNewLine & "Error number:  " & Err.Number, vbCritical, "  "
Exit Sub
End Sub
 
Last edited:

Cris VS

Member
Local time
Today, 15:16
Joined
Sep 16, 2021
Messages
75
Hello again,

I have tried to do what you suggest in these posts but I am getting an compile error (User-defined type not defined). It highlights the "xlApp As Excel.Application" declaration of the code. The reference to the MS Office 16 is ticked, so I am guessing it's not related to this. How can I fix this?

Cheers

Code:
Private Sub ExportToExcel_Click()

On Error GoTo SubError

DoCmd.Hourglass (True)
  
   'Dim xlApp As Object
    'Dim xlBook As Object
    'Dim xlSheet As Object
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    ' Variables for data retrieval
    Dim SQL1 As String
    Dim rs1 As DAO.Recordset
  
    'Export Query 1: Event details: Event,Deadline, DerogationDate, EventNotes from TableEvent
    SQL1 = "ExportQuery1" & "WHERE [Event]=" & Me.Event
    Set rs1 = CurrentDb.OpenRecordset(SQL1, dbOpenSnapshot)
    
    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 = xlBook.Worksheets(1)
    
    With xlSheet
        .Name = "Main"
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 11
        
        'Event - column A
        .Columns("A").AutoFit
        'Deadline - column B
        .Columns("B").AutoFit
        'Derogation date - column C
        .Columns("C").AutoFit
        'Event notes - column D
        .Columns("D").ColumnWidth = 50
        .Columns("D").WrapText = True
        
        'Copy data
        .Range("A2").CopyFromRecordset rs1
    
    End With
  
  MsgBox "File exported succesfully", vbInformation + vbOKOnly, "Export success"

SubError:
    MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, _
    "An error occurred"
    GoTo SubExit

SubExit:
    On Error Resume Next
    DoCmd.Hourglass (False)
    Exit Sub
    
End Sub
 

Cris VS

Member
Local time
Today, 15:16
Joined
Sep 16, 2021
Messages
75
Add to project references "Microsoft Excel XX.X Object Library", or return everything as it was
I had added the reference but as it wasn't working I have tried to do it with Objects instead of Excel.xxx and now I get error "Object variable or With block variable not set".

I have tried commenting the code and uncommenting line by line to see where the error is and it seems to be here, but I don't know why
Set xlSheet = xlBook.Worksheets(1)
 

Eugene-LS

Registered User.
Local time
Today, 17:16
Joined
Dec 7, 2018
Messages
481
have tried commenting the code and uncommenting line by line to see where the error is and it seems to be here, but I don't know why
That should fire! :)
Code:
Private Sub ExportToExcel_Click()

'Dim xlApp As Object
'Dim xlWorkbook As Object
'Dim xlSheet As Object
    Dim xlApp As Excel.Application
    Dim xlWorkbook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
'
    ' Variables for data retrieval
    Dim SQL1 As String
    Dim rs1 As DAO.Recordset

On Error GoTo SubError
 
    DoCmd.Hourglass True
      
 
    'Export Query 1: Event details: Event,Deadline, DerogationDate, EventNotes from TableEvent
    SQL1 = "ExportQuery1" & "WHERE [Event]=" & Me.Event
    Set rs1 = CurrentDb.OpenRecordset(SQL1, dbOpenSnapshot)

    If rs1.RecordCount = 0 Then
        MsgBox "No data available for export", vbInformation + vbOKOnly, "Excel not launched"
        GoTo SubExit
    End If
    
    Set xlApp = Excel.Application

Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = False
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlSheet = xlWorkbook.Worksheets(1)
    
    With xlSheet
        .Name = "Main"
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 11
        
        'Event - column A
        .Columns("A").AutoFit
        'Deadline - column B
        .Columns("B").AutoFit
        'Derogation date - column C
        .Columns("C").AutoFit
        'Event notes - column D
        .Columns("D").ColumnWidth = 50
        .Columns("D").WrapText = True
        
        'Copy data
        .Range("A2").CopyFromRecordset rs1
    
    End With
  xlApp.Visible = True
  MsgBox "File exported succesfully", vbInformation + vbOKOnly, "Export success"


SubExit:
    DoCmd.Hourglass False
    On Error Resume Next
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
    Exit Sub
    
SubError:
    MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, _
    "An error occurred"
    Err.Clear
    Resume SubExit
    
End Sub
 

Cris VS

Member
Local time
Today, 15:16
Joined
Sep 16, 2021
Messages
75
That should fire! :)
I have copied the code and selected the reference to both Microsoft Office 16.0 Access database engine Object Library and Microsoft Office 16.0 Object Library, but I am back to compile error "User-defined type not defined" on line "Dim xlApp As Excel.Application" :(
 

Eugene-LS

Registered User.
Local time
Today, 17:16
Joined
Dec 7, 2018
Messages
481
I have copied the code and selected the reference to both Microsoft Office 16.0 Access database engine Object Library and Microsoft Office 16.0 Object
That's not enough ...
Add to project references "Microsoft Excel XX.X Object Library", or use "Late Binding"
 

Attachments

  • Снимок.PNG
    Снимок.PNG
    20.2 KB · Views: 374

Cris VS

Member
Local time
Today, 15:16
Joined
Sep 16, 2021
Messages
75
To close up this thread, I would really appreciate if someone could explain how to select only the information of each query related to the Event of the form. Basically, how to adapt this "selection" of the current EventID
docmd.OpenReport "EventSummary",acViewPreview,, "[eventID]=" & me.eventid, acHidden
DoCmd.OutputTo acOutputReport, "EventSummary", acFormatXLS, "\\path\Events archive\" & [Event] & ".xls"
MsgBox "File exported succesfully", vbInformation + vbOKOnly, "Export success"
DoCmd.Close acReport, "EventSummary"

to this way of exporting.
That should fire! :)
Code:
Private Sub ExportToExcel_Click()

'Dim xlApp As Object
'Dim xlWorkbook As Object
'Dim xlSheet As Object
    Dim xlApp As Excel.Application
    Dim xlWorkbook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
'
    ' Variables for data retrieval
    Dim SQL1 As String
    Dim rs1 As DAO.Recordset

On Error GoTo SubError

    DoCmd.Hourglass True
    

    'Export Query 1: Event details: Event,Deadline, DerogationDate, EventNotes from TableEvent
    SQL1 = "ExportQuery1" & "WHERE [Event]=" & Me.Event
    Set rs1 = CurrentDb.OpenRecordset(SQL1, dbOpenSnapshot)

    If rs1.RecordCount = 0 Then
        MsgBox "No data available for export", vbInformation + vbOKOnly, "Excel not launched"
        GoTo SubExit
    End If
  
    Set xlApp = Excel.Application

Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = False
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlSheet = xlWorkbook.Worksheets(1)
  
    With xlSheet
        .Name = "Main"
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 11
      
        'Event - column A
        .Columns("A").AutoFit
        'Deadline - column B
        .Columns("B").AutoFit
        'Derogation date - column C
        .Columns("C").AutoFit
        'Event notes - column D
        .Columns("D").ColumnWidth = 50
        .Columns("D").WrapText = True
      
        'Copy data
        .Range("A2").CopyFromRecordset rs1
  
    End With
  xlApp.Visible = True
  MsgBox "File exported succesfully", vbInformation + vbOKOnly, "Export success"


SubExit:
    DoCmd.Hourglass False
    On Error Resume Next
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
    Exit Sub
  
SubError:
    MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, _
    "An error occurred"
    Err.Clear
    Resume SubExit
  
End Sub
I have read it has to be done using parameters but I don't know how to declare/use them in VBA.

Thank you very much
 

Users who are viewing this thread

Top Bottom