Results 1 to 9 of 9
  1. #1
    jo15765's Avatar
    jo15765 is offline Expert
    Windows 10 Access 2013 64bit
    Join Date
    Nov 2010
    Location
    6 Feet Under
    Posts
    670

    Export SQL String To Excel


    I am attempting to export an access sql string to Excel - the problem is my syntax will not export to Excel. I have the below code, but something is awry with it. Can someone point out what I need to do to fix my code?
    Code:
     Option Compare DatabaseOption Explicit
    Public param As String
    
    
    Public Function CreateQueryToExportToExcel()
        Dim saveloc As String, strWorksheetPath As String, xl As Object, wb As Object
        Dim exportsheet As Object, Header As Variant, OIHeader As Variant
        Dim db As DAO.Database, ExportRecordSet As DAO.Recordset
        Dim row As Integer, i As Integer, colLetter As String
    
    
        'Turning warnings off for procedure to execute
        'Commented out to get an error message if present
        'DoCmd.SetWarnings False
    
    
        'Setting Save location
        saveloc = Environ("USERPROFILE") & "\Desktop\"
        saveloc = strWorksheetPath & "Test.xlsx"
    
    
        'Set db = CurrentDb
    
    
        'Instantiating Excel
        Set xl = CreateObject("Excel.Application")
    
    
        'Turning off Excel Warnings
    	'Turning off warnings for testing
        'xl.DisplayAlerts = False
    
    
        'Adding new workbook to Excel Object
        Set wb = xl.Workbooks.Add
    
    
        'Naming worksheets
        Set exportsheet = wb.Worksheets(1)
        exportsheet.Name = "Test"
    
    
        'Setting Excel To Visible
        xl.Application.Visible = True
    
    
        'Creating Array For Headers
        Header = Array("One", "Two", "Threre", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen")
    
    
        'Setting which elements of Array Go To Sheet1
        OIHeader = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
    
    
        'Actual Query that will be used to export to Excel
        Set ExportRecordSet = db.OpenRecordset(" SELECT One, Two, Threre, Four, Five, Six, Seven, Eight, Nine, Ten, Eleven,     Twelve, Thirteen, Fourteen, Fifteen " & _
                                               " from testdata WHERE [four] ='" & param & "';")
    
    
        row = 1
    
    
        'Writing Header Info To Sheet1
        For i = LBound(OIHeader) To UBound(OIHeader)
            exportsheet.Cells(row, i + 1).Value = Header(OIHeader(i))
        Next i
    
    
        'Formatting Text For Sheet1
        exportsheet.Range("A1:P1").Font.Bold = True
        exportsheet.Range("A1:P1").Font.Size = 16
        exportsheet.Range("A1:P1").Interior.ColorIndex = 15
    
    
        row = row + 1
        If Not ExportRecordSet.EOF Then
            While Not ExportRecordSet.EOF
                    'Writing Data To Sheet 1
                    exportsheet.Cells(row, 1).Value = ExportRecordSet("One")
                    exportsheet.Cells(row, 2).Value = ExportRecordSet("Two")
                    exportsheet.Cells(row, 3).Value = ExportRecordSet("Threre")
                    exportsheet.Cells(row, 4).Value = ExportRecordSet("Four")
                    exportsheet.Cells(row, 5).Value = ExportRecordSet("Five")
                    exportsheet.Cells(row, 6).Value = ExportRecordSet("Six")
                    exportsheet.Cells(row, 7).Value = ExportRecordSet("Seven")
                    exportsheet.Cells(row, 8).Value = ExportRecordSet("Eight")
                    exportsheet.Cells(row, 9).Value = ExportRecordSet("Nine")
                    exportsheet.Cells(row, 10).Value = ExportRecordSet("Ten")
                    exportsheet.Cells(row, 11).Value = ExportRecordSet("Eleven")
                    exportsheet.Cells(row, 12).Value = ExportRecordSet("Twelve")
                    exportsheet.Cells(row, 13).Value = ExportRecordSet("Thirteen")
                    exportsheet.Cells(row, 14).Value = ExportRecordSet("Fourteen")
                    exportsheet.Cells(row, 15).Value = ExportRecordSet("Fifteen")
           ExportRecordSet.MoveNext
           row = row + 1
          Wend
          ExportRecordSet.Close
        End If
    
    
        'Autofitting Headers
        For i = 1 To 16
            colLetter = ColumnLetter(i)
            exportsheet.Columns(colLetter & ":" & colLetter).Autofit
        Next i
    
    
        'Selecting the first worksheet
        exportsheet.Activate
        exportsheet.Range("A1").Activate
    
    
        'Saving the workbook
        wb.SaveAs FileName:=saveloc
    
    
        'Closing the workbook
        wb.Close
    
    
        'Turning warnings back on since procedure is complete
        'DoCmd.SetWarnings True
    
    
        'Turning the Excel Warnings Back on
        'xl.DisplayAlerts = False
    
    
    End Function

  2. #2
    kd2017 is offline Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    1,142
    I don't know if this has anything to do with anything but your header array has 15 vals while the oiheader array has 16. Seems like oiheader should be 0 to 14, otherwise it could cause a hickup at 'writing header info to sheet 1'.

  3. #3
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    WHICH line does not export?

  4. #4
    jo15765's Avatar
    jo15765 is offline Expert
    Windows 10 Access 2013 64bit
    Join Date
    Nov 2010
    Location
    6 Feet Under
    Posts
    670
    Quote Originally Posted by ranman256 View Post
    WHICH line does not export?
    It hits the Set ExportRecordSet line and I get an error of "Object variable or with block variable not set"

    ***Sorry I thought I included that in my OP

  5. #5
    kd2017 is offline Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    1,142
    This code works (I tried to mark everwhere I made changes with <------------- KD2017 some comment):

    Code:
    Option Compare Database
    Option Explicit
    Public param As String
    
    
    Public Function CreateQueryToExportToExcel()
        Dim saveloc As String, strWorksheetPath As String, xl As Object, wb As Object
        Dim exportsheet As Object, Header As Variant, OIHeader As Variant
        Dim db As DAO.Database, ExportRecordSet As DAO.Recordset
        Dim row As Integer, i As Integer, colLetter As String
    
    
        'Turning warnings off for procedure to execute
        'Commented out to get an error message if present
        'DoCmd.SetWarnings False
    
    
        'Setting Save location
        saveloc = Environ("USERPROFILE") & "\Desktop\"
        saveloc = strWorksheetPath & "Test.xlsx"
    
    
        Set db = CurrentDb '<----------------- KD2017 Uncommented this line
    
    
        'Instantiating Excel
        Set xl = CreateObject("Excel.Application")
    
    
        'Turning off Excel Warnings
        'Turning off warnings for testing
        'xl.DisplayAlerts = False
    
    
        'Adding new workbook to Excel Object
        Set wb = xl.Workbooks.Add
    
    
        'Naming worksheets
        Set exportsheet = wb.Worksheets(1)
        exportsheet.Name = "Test"
    
    
        'Setting Excel To Visible
        xl.Application.Visible = True
    
    
        'Creating Array For Headers
        Header = Array("One", "Two", "Threre", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen")
    
    
        'Setting which elements of Array Go To Sheet1
        OIHeader = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14) '<----------------- KD2017 Deleted 15
    
    
        'Actual Query that will be used to export to Excel
        Set ExportRecordSet = db.OpenRecordset(" SELECT One, Two, Threre, Four, Five, Six, Seven, Eight, Nine, Ten, Eleven,     Twelve, Thirteen, Fourteen, Fifteen " & _
                                               " from testdata WHERE [four] ='" & param & "';")
    
    
        row = 1
    
    
        'Writing Header Info To Sheet1
        For i = LBound(OIHeader) To UBound(OIHeader)
            exportsheet.Cells(row, i + 1).Value = Header(OIHeader(i))
        Next i
    
    
        'Formatting Text For Sheet1
        exportsheet.Range("A1:P1").Font.Bold = True
        exportsheet.Range("A1:P1").Font.Size = 16
        exportsheet.Range("A1:P1").Interior.ColorIndex = 15
    
    
        row = row + 1
        If Not ExportRecordSet.EOF Then
            While Not ExportRecordSet.EOF
                    'Writing Data To Sheet 1
                    exportsheet.Cells(row, 1).Value = ExportRecordSet("One")
                    exportsheet.Cells(row, 2).Value = ExportRecordSet("Two")
                    exportsheet.Cells(row, 3).Value = ExportRecordSet("Threre")
                    exportsheet.Cells(row, 4).Value = ExportRecordSet("Four")
                    exportsheet.Cells(row, 5).Value = ExportRecordSet("Five")
                    exportsheet.Cells(row, 6).Value = ExportRecordSet("Six")
                    exportsheet.Cells(row, 7).Value = ExportRecordSet("Seven")
                    exportsheet.Cells(row, 8).Value = ExportRecordSet("Eight")
                    exportsheet.Cells(row, 9).Value = ExportRecordSet("Nine")
                    exportsheet.Cells(row, 10).Value = ExportRecordSet("Ten")
                    exportsheet.Cells(row, 11).Value = ExportRecordSet("Eleven")
                    exportsheet.Cells(row, 12).Value = ExportRecordSet("Twelve")
                    exportsheet.Cells(row, 13).Value = ExportRecordSet("Thirteen")
                    exportsheet.Cells(row, 14).Value = ExportRecordSet("Fourteen")
                    exportsheet.Cells(row, 15).Value = ExportRecordSet("Fifteen")
           ExportRecordSet.MoveNext
           row = row + 1
          Wend
          ExportRecordSet.Close
        End If
    
    
        'Autofitting Headers
        Dim ColumnLetter() As Variant '<----------------- KD2017 declared this variable
        ColumnLetter = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P") '<----------------- KD2017 Note P is the 16th column, data only has 15 columns
        For i = 0 To 15 '<----------------- KD2017 adjusted range
            colLetter = ColumnLetter(i)
            exportsheet.Columns(colLetter & ":" & colLetter).Autofit
        Next i
    
    
        'Selecting the first worksheet
        exportsheet.Activate
        exportsheet.Range("A1").Activate
    
    
        'Saving the workbook
        wb.SaveAs FileName:=saveloc
    
    
        'Closing the workbook
        wb.Close
    
    
        'Turning warnings back on since procedure is complete
        'DoCmd.SetWarnings True
    
    
        'Turning the Excel Warnings Back on
        'xl.DisplayAlerts = False
    
    
    End Function
    
    Sub test()    '<----------------- KD2017 sub to run function
        param = "Hi"
        CreateQueryToExportToExcel
    End Sub

  6. #6
    jo15765's Avatar
    jo15765 is offline Expert
    Windows 10 Access 2013 64bit
    Join Date
    Nov 2010
    Location
    6 Feet Under
    Posts
    670
    @KD2017 - if I step through the code, it did everything as I expected, but for some reason it is not saving the file?\


    Excel will even prompt that a file with the same name already exists in this location, do you want to overwrite and I click yes, but I do not see a file on my desktop!

    EDIT --->
    If I change the save dir to for example C:\Test\ it saves as it should, but for some reason saving on the desktop I have a 50/50 chance if the file will actually display. WHy is that?

  7. #7
    kd2017 is offline Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    1,142
    I actually noticed that too, I have no idea why it's doing that. I initially just chalked it up to the desktop not refreshing or something... Interesting.

  8. #8
    kd2017 is offline Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    1,142
    Quote Originally Posted by kd2017 View Post
    I actually noticed that too, I have no idea why it's doing that. I initially just chalked it up to the desktop not refreshing or something... Interesting.
    I just realized your saveloc doesn't look quite right.

    Code:
    saveloc = Environ("USERPROFILE") & "\Desktop\"
    saveloc = strWorksheetPath & "Test.xlsx"
    Maybe try

    Code:
    strWorksheetPath = Environ("USERPROFILE") & "\Desktop\"
    saveloc = strWorksheetPath & "Test.xlsx"

  9. #9
    ssanfu is offline Master of Nothing
    Windows 7 32bit Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    I modified the code by kd2017.

    Maybe try this:
    Code:
    Option Compare Database
    Option Explicit
    
    Public param As String
    
    
    Public Function CreateQueryToExportToExcel()
        Dim db As DAO.Database
        Dim ExportRecordSet As DAO.Recordset
    
        Dim wb As Object
        Dim xl As Object
        Dim exportsheet As Object
    
        Dim saveloc As String
        Dim row As Integer
        Dim i As Integer
        Dim sSQL As String
        Dim FieldCount As Integer
    
        'Turning warnings off for procedure to execute
        'Commented out to get an error message if present
        'DoCmd.SetWarnings False
    
        'Setting Save location
        saveloc = Environ("USERPROFILE") & "\Desktop\Test.xlsx"
    
        Set db = CurrentDb    '<----------------- KD2017 Uncommented this line
    
        'Actual Query that will be used to export to Excel
        sSQL = "SELECT One, Two, Three, Four, Five, Six, Seven, Eight, Nine,"
        sSQL = sSQL & " Ten, Eleven, Twelve, Thirteen, Fourteen, Fifteen"
        sSQL = sSQL & " FROM testdata"
        sSQL = sSQL & " WHERE [four] ='" & param & "';"
        '    Debug.Print sSQL
        Set ExportRecordSet = db.OpenRecordset(sSQL)
        If Not ExportRecordSet.BOF And Not ExportRecordSet.EOF Then
    
            'number of fields in record set
            FieldCount = ExportRecordSet.Fields.Count - 1
    
            'Instantiating Excel
            Set xl = CreateObject("Excel.Application")
    
            'Turning off Excel Warnings
            'Turning off warnings for testing
            'xl.DisplayAlerts = False
    
            'Adding new workbook to Excel Object
            Set wb = xl.Workbooks.Add
    
            'Naming worksheets
            Set exportsheet = wb.Worksheets(1)
            exportsheet.Name = "Test"
    
            'Setting Excel To Visible
            xl.Application.Visible = True
    
            row = 1
    
            'Writing Header Info To Sheet1
            For i = 0 To FieldCount
                exportsheet.Cells(row, i + 1) = ExportRecordSet.Fields(i).Name
            Next i
    
            'Formatting Text For Sheet1
            With exportsheet.Range(Chr(65) & "1:" & Chr(65 + FieldCount) & "1")
                .Font.Bold = True
                .Font.Size = 16
                .Interior.ColorIndex = 15
            End With
    
            row = row + 1
            While Not ExportRecordSet.EOF
                'Writing Data To Sheet 1
                For i = 0 To FieldCount
                    exportsheet.Cells(row, i + 1).Value = ExportRecordSet.Fields(i)
                Next
    
                ExportRecordSet.MoveNext
                row = row + 1
            Wend
    
            'close record set
            ExportRecordSet.Close
    
            'Autofitting Headers
            exportsheet.Columns(Chr(65) & ":" & Chr(65 + FieldCount)).Autofit
    
            'Selecting the first worksheet
            exportsheet.Activate
            exportsheet.Range("A1").Activate
    
            'Saving the workbook
            wb.SaveAs FileName:=saveloc
    
    
            'Closing the workbook
            xl.Quit
        Else
            MsgBox "No data found to export"
        End If
    
        'Turning warnings back on since procedure is complete
        'DoCmd.SetWarnings True
    
        'Turning the Excel Warnings Back on
        'xl.DisplayAlerts = False
    
        On Error Resume Next
    
        'clean up
        Set ExportRecordSet = Nothing
        Set db = Nothing
    
        Set exportsheet = Nothing
        Set xl = Nothing
        Set wb = Nothing
    
    End Function
    
    Sub test()    '<----------------- KD2017 sub to run function
        param = "Hi"
        CreateQueryToExportToExcel
    End Sub

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 3
    Last Post: 04-07-2016, 04:36 AM
  2. Export Queries to Excel with Combo-Box visible in Excel
    By johnmarc2 in forum Import/Export Data
    Replies: 1
    Last Post: 07-07-2014, 05:33 PM
  3. Replies: 7
    Last Post: 04-25-2013, 03:47 PM
  4. Replies: 3
    Last Post: 10-07-2011, 07:49 AM
  5. Replies: 1
    Last Post: 03-25-2010, 03:12 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums