none
FORMATING OUTPUT EXCEL FILES THROUGH ACCESS VBA CODES RRS feed

  • Question

  • Good morning guys,

    I need to be able to export some data from my database in a specific layout, does anyone have any good sample VBA codes of customizable excel exports through access? Here's what I need my export to look exactly like.

    Wednesday, August 30, 2017 11:24 AM

Answers

  • Sorry, I forgot to mention, you may have to add to Daniel's code to close the Excel file at the end of the function. As it is right now, I think the function assumes the user wants to see the result, so the file stays open.

    Try something like: Quit or Exit

    If you want it to stay open, then you'll have to try the GetObject() method first to grab the already opened Excel file.

    Hope it helps...

    • Marked as answer by InnVis Tuesday, September 5, 2017 2:56 PM
    Thursday, August 31, 2017 5:10 PM
  • Hi Alex,

    Since, I think, you've had enough practice automating Excel, you might be able to go back to your original code and simply add all the formatting statements to your Excel file with all the departments already in separate tabs.

    Just a thought...

    • Marked as answer by InnVis Tuesday, September 5, 2017 2:56 PM
    Monday, September 4, 2017 4:28 PM

All replies

  • One method is to use Excel Automation. You will need to learn the Excel object model in order to do this. Besides looking at examples you can use the macro recorder in Excel to generate some of your code. The below link should get you started:

    How to automate Microsoft Excel from Visual Basic

    You can also ask questions about Excel Automation in the Excel for Developers forum.


    Paul ~~~~ Microsoft MVP (Visual Basic)

    Wednesday, August 30, 2017 1:00 PM
  • Hi,

    In addition, you can create a template Excel file and then simply plug your data into it, so you don't have to format the result using code.

    Just my 2 cents...

    Wednesday, August 30, 2017 2:46 PM
  • How do I do this? Is there a way to save the Excel template somewhere to go with the database that way users are not required to have the template saved on their computers to be able to generate the report?
    Wednesday, August 30, 2017 3:00 PM
  • Yes, you can store the template somewhere on the network as long as users have access to it. Or, you can install the template with the database when you install the frontend.
    Wednesday, August 30, 2017 3:03 PM
  • Every time I generate a report, will it over-write the excel "template" or will it create a new excel file with the template of the "template excel"?
    Wednesday, August 30, 2017 3:18 PM
  • If you create a "true" template, then Excel will prompt you to save it with a different filename to preserve the template. You can also automate this part. If it's not a true template, you can use code to simply save the file with a different filename to leave the "template" file intact.

    Wednesday, August 30, 2017 3:20 PM
  • Leo,

    Do you have a link to a site with some samples? Checked utteraccess, no luck.

    Wednesday, August 30, 2017 3:30 PM
  • Do you have a link to a site with some samples? Checked utteraccess, no luck.

    I found this one at UtterAccess...
    Wednesday, August 30, 2017 3:33 PM
  • I agree with theDBguy, create as much of the static layout as a Template file and the use automation to do everything else. Below are a few resource that should help get you started


    Daniel Pineault, 2010-2017 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net


    Wednesday, August 30, 2017 4:46 PM
  • Alright, SO after spending some time trying to wrap my head around this project - I don't think I'll be able to work with the template idea because it is a bit more complicated than my skills can handle at this time and the excel report I need formatted is very simple. I adapted this code to work, but I need to somehow modify it so it lets me add the formats to the excel sheet. Any thoughts?

    Dim db As DAO.Database, rs As DAO.Recordset, str1Sql As QueryDef, strCrt As String
    Dim strReportName As String
    Dim strPathUser As String
    Dim strFilePath As String
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT DISTINCT Service FROM qryPerstatMuster ORDER By Service;")
    strReportName = "PERSTATS"
    strPathUser = Environ$("USERPROFILE") & "\my documents\"
    strFilePath = strPathUser & Format(Date, "ddMMMyy") & "_" & strReportName & ".xls"
    
    rs.MoveLast
    rs.MoveFirst
    Do While Not rs.EOF
    strCrt = rs.Fields(0)
    Set str1Sql = db.CreateQueryDef("" & strCrt, "SELECT qryPerstatMuster.*  FROM qryPerstatMuster WHERE qryPerstatMuster.Service = '" & strCrt & "';")
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "" & strCrt, strFilePath, True
    DoCmd.DeleteObject acQuery, "" & strCrt
    rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Set db = Nothing

    Wednesday, August 30, 2017 10:20 PM
  • One of the reasons why I suggested sticking with Excel Automation was because of the cell formatting you have and the fact that the number of rows appears to be dynamic. I think a template is fine if you have kind of a cookie cutter implementation but it doesn't work very well if the report requires customization and is somewhat dynamic in size.

    If part of the Worksheet consists of rows of data you can use CopyFromRecordset to quickly populate starting at a particular cell, but then you will need to color the interior of the cells using automation. There is a link in my prior post that has some code which demonstrates how to color those cells using Excel Range objects. You should be able to do this relatively easily since you can determine how many rows are in the Recordset and use that in your Range.


    Paul ~~~~ Microsoft MVP (Visual Basic)

    Thursday, August 31, 2017 12:23 AM
  • Hello,

    You could write macro in Excel to get data from Access using DAO or ADO and then add formats. You could also keep your current code in Access and automate Excel to format the cells or tabs. You could visit the links shared above to open the exported Excel file and then use some code like the following to set tab color and columns color.

    Sheets("Sheet1").Tab.Color = RGB(255, 255, 0)
    Sheets("Sheet1").Columns("A:A").Interior.Color = RGB(255, 0, 0)

    You could record macro if you dont know what objects or methods to use .Please visit Automate tasks with the Macro Recorder

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, August 31, 2017 3:18 AM
    Moderator
  • Here's what I came up with so far, missing more formats but it works thus far. Any thoughts?

    Private Sub cmdTESTREPORTS_Click()
          Dim oXL As Excel.Application
          Dim oWB As Excel.Workbook
          Dim oSheet As Excel.Worksheet
          Dim oRng As Excel.Range
          Dim db As DAO.Database, rs As DAO.Recordset, str1Sql As QueryDef, strCrt As String
          Dim strReportName As String
          Dim strPathUser As String
          Dim strFilePath As String
          
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT DISTINCT Service FROM qryPerstatMuster ORDER By Service;")
    strReportName = "PERSTATS"
    strPathUser = Environ$("USERPROFILE") & "\my documents\"
    strFilePath = strPathUser & Format(Date, "ddMMMyy") & "_" & strReportName & ".xls"
    
    rs.MoveLast
    rs.MoveFirst
    Do While Not rs.EOF
    strCrt = rs.Fields(0)
    Set str1Sql = db.CreateQueryDef("" & strCrt, "SELECT qryPerstatMuster.*  FROM qryPerstatMuster WHERE qryPerstatMuster.Service = '" & strCrt & "';")
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "" & strCrt, strFilePath, True
    DoCmd.DeleteObject acQuery, "" & strCrt
    
    rs.MoveNext
    
    Loop
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    
    Set oXL = CreateObject("Excel.Application")
    oXL.Application.Workbooks.Open strFilePath
    oXL.Visible = True
    Set oWB = oXL.ActiveWorkbook
    Set oSheet = oWB.ActiveSheet
    'Set oRng = oSheet.Range("A1", "D1")
    
        For Each oSheet In oWB.Sheets
        
           With oSheet.Range("A1", "L1")
             .Font.Bold = True
             .VerticalAlignment = xlVAlignCenter
             .EntireColumn.AutoFit
             .HorizontalAlignment = xlCenter
        End With
      Next
    
          oXL.Visible = True
          oXL.UserControl = True
    
          Set oRng = Nothing
          Set oSheet = Nothing
          Set oWB = Nothing
          Set oXL = Nothing
          
       Exit Sub
    Err_Handler:
          MsgBox Err.Description, vbCritical, "Error: " & Err.Number
    
    End Sub
    

    Thursday, August 31, 2017 11:28 AM
  • If it's working for you then I would go with the approach. One thing I would make sure to do is to close any Workbook objects and call the Quit method for the Excel Application object before setting any Excel objects you have created to Nothing. Otherwise the Excel app may remain in memory after the Access app has terminated.

    Paul ~~~~ Microsoft MVP (Visual Basic)

    Thursday, August 31, 2017 1:41 PM
  • Better yet... how can I adapt this function to export my query as 1 new tab per different field "Service" as my original loop does?

    Function Export2XLS(ByVal sQuery As String)
        Dim oExcel          As Object
        Dim oExcelWrkBk     As Object
        Dim oExcelWrSht     As Object
        Dim bExcelOpened    As Boolean
        Dim db              As DAO.Database
        Dim rs              As DAO.Recordset
        Dim iCols           As Integer
        Const xlCenter = -4108
     
        'Start Excel
        On Error Resume Next
        Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel
     
        If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
            Err.Clear
            On Error GoTo Error_Handler
            Set oExcel = CreateObject("Excel.Application")
            bExcelOpened = False
        Else    'Excel was already running
            bExcelOpened = True
        End If
        On Error GoTo Error_Handler
        oExcel.ScreenUpdating = False
        oExcel.Visible = False   'Keep Excel hidden until we are done with our manipulation
        Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook
        Set oExcelWrSht = oExcelWrkBk.Sheets(1)
     
        'Open our SQL Statement, Table, Query
        Set db = CurrentDb
        Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
        With rs
            If .RecordCount <> 0 Then
                'Build our Header
                For iCols = 0 To rs.Fields.Count - 1
                    oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
                Next
                With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                                       oExcelWrSht.Cells(1, rs.Fields.Count))
                    .Font.Bold = True
                    .Font.ColorIndex = 2
                    .Interior.ColorIndex = 1
                    .HorizontalAlignment = xlCenter
                End With
                'Copy the data from our query into Excel
                oExcelWrSht.Range("A2").CopyFromRecordset rs
                oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                                  oExcelWrSht.Cells(1, rs.Fields.Count)).Columns.AutoFit    'Resize our Columns based on the headings
                oExcelWrSht.Range("A1").Select  'Return to the top of the page
            Else
                MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
                GoTo Error_Handler_Exit
            End If
        End With
     
        '    oExcelWrkBk.Close True, sFileName 'Save and close the generated workbook
     
        '    'Close excel if is wasn't originally running
        '    If bExcelOpened = False Then
        '        oExcel.Quit
        '    End If
     
    Error_Handler_Exit:
        On Error Resume Next
        oExcel.Visible = True   'Make excel visible to the user
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Set oExcelWrSht = Nothing
        Set oExcelWrkBk = Nothing
        oExcel.ScreenUpdating = True
        Set oExcel = Nothing
        Exit Function
     
    Error_Handler:
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: Export2XLS" & vbCrLf & _
               "Error Description: " & Err.Description _
               , vbOKOnly + vbCritical, "An Error has Occured!"
        Resume Error_Handler_Exit
    End Function

    Thursday, August 31, 2017 2:14 PM
  • Did you look over the section entitled "Taking Things Even Further :: ExportRecordset2XLS V2.0!" from the https://www.devhut.net/2017/03/15/ms-access-vba-export-recordset-to-excel/ link I provided?  It should get you to where you want to be.

    Daniel Pineault, 2010-2017 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net

    Thursday, August 31, 2017 2:21 PM
  • I did, can't really wrap my head around the code - I'm still very much a novice. I did notice that the second code is to export data from a form, the first one is to extract data from a query. I want to extract the data from my query, but I want the excel file to create a new sheet per field named "Service" and input the corresponding data into it and not just all data in 1 sheet.
    Thursday, August 31, 2017 2:58 PM
  • Hi Alex,

    I see Daniel's Export2XLS() function accepts a SQL string, so all you should have to do is create a loop like you had in your previous code and pass the SQL string to Daniel's function in each iteration of the loop. Also, rather than using the default Sheets(1), you might have to use the Sheets.Add method, so each Service is in its own tab in the spreadsheet. So, in pseudocode:

    Set rs = OpenRecordset(DISTINCT Services)

    Do While Not rs.EOF

    strSQL = "SELECT records for " & rs!Service

    Export2XLS strSQL

    rs.MoveNext

    Loop

    Hope it helps...

    • Marked as answer by InnVis Thursday, August 31, 2017 5:23 PM
    • Unmarked as answer by InnVis Thursday, August 31, 2017 5:23 PM
    Thursday, August 31, 2017 4:38 PM
  • This sort of works, except it opens 1 different excel per record. How can it be made into sheets within the same excel instead?

    Private Sub cmdTESTREPORTS2_Click()
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim strCrt As String
    
    Set rs = CurrentDb.OpenRecordset("SELECT DISTINCT Service FROM qryPerstatMuster ORDER By Service;")
    
    Do While (Not rs.EOF)
    strCrt = rs.Fields(0)
    strSQL = "SELECT qryPerstatMuster.*  FROM qryPerstatMuster WHERE qryPerstatMuster.Service = '" & strCrt & "';"
    Export2XLS strSQL
    rs.MoveNext
    Loop
    
    End Sub

    Thursday, August 31, 2017 5:04 PM
  • Sorry, I forgot to mention, you may have to add to Daniel's code to close the Excel file at the end of the function. As it is right now, I think the function assumes the user wants to see the result, so the file stays open.

    Try something like: Quit or Exit

    If you want it to stay open, then you'll have to try the GetObject() method first to grab the already opened Excel file.

    Hope it helps...

    • Marked as answer by InnVis Tuesday, September 5, 2017 2:56 PM
    Thursday, August 31, 2017 5:10 PM
  • By the way Daniel, your function is incredible. Thank you for sharing.
    Friday, September 1, 2017 11:09 AM
  • Hello,

    >>This sort of works, except it opens 1 different excel per record. How can it be made into sheets within the same excel instead?

    You could use the 2nd function with some parameters which speicify workbook and sheet. E.g. Call ExportRecordset2XLS(rs,fileName,sheetName)

    Function ExportRecordset2XLS(ByVal rs As DAO.Recordset, _
                                 Optional ByVal sFile As String, _
                                 Optional ByVal sWrkSht As String, _
                                 Optional ByVal lStartCol As Long = 1, _
                                 Optional ByVal lStartRow As Long = 1, _
                                 Optional bFitCols As Boolean = True, _
                                 Optional bFreezePanes As Boolean = True, _
                                 Optional bAutoFilter As Boolean = True)

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, September 4, 2017 8:15 AM
    Moderator
  • Hi Alex,

    Since, I think, you've had enough practice automating Excel, you might be able to go back to your original code and simply add all the formatting statements to your Excel file with all the departments already in separate tabs.

    Just a thought...

    • Marked as answer by InnVis Tuesday, September 5, 2017 2:56 PM
    Monday, September 4, 2017 4:28 PM