Automating Access queries for Excel sheet population not using ADO or DAO

[JimSnyder]

I have a problem that I am working on a solution for. There are three tables in a dedicated Access DB (.accdb) that I am trying to generate Excel reports from. My company's network is locked down so tight that although I can make an ADO connection, it errors out when creating the recordset.

I can run the queries from Access, but have not figured out how to export the results to a spreadsheet. I can also pull back a querytable from Excel, but am limited to a string length for the query of 255 and am still working on getting a second query to return a second table's data.

I have been searching for a few days and have found bits and pieces, but not enough to complete the automation. Below is the QueryTable code that I have been working on. I am open to any suggestions, not limited to what I have written.

'################################################################################
'## Module: BuildSourceWkBk
'################################################################################
'
' Purpose:  This function uses a querytable with query to build a source workbook
'           containing querytable sheet, an EPIC sheet, a STAR sheet, and a
'           Recondo sheet sourced from an Access DB.
' Created:  04/24/2015
' Author:   Jim Snyder
'
' Inputs:   Requires a reference to a workbook, a reference to each sheet, and
'           a name for the workbook created within.
'
' Outputs:  Workbook with source data from EPIC, STAR, and Recondo.
'
' Methods:  variables as Camelcase, functions as first letter of each word
'           capitalized, Excel defines and objects as Hungarian notation.
'
' Include:  Microsoft Office 15.0 Object Library - used to automate Access
'
'################################################################################
'## Versioning
'################################################################################
'## Vers    Date        Coder       Change Description
'################################################################################
'   1.00    05/04/2015  Jim Snyder  Initial release: feature list includes
'                                   ...


Option Explicit ' Must declare variables - clean programming technique


Public Function BuildQueryWkBk(ByRef sourceWkBk As Workbook, _
    ByRef epicSheet As Worksheet, _
    ByRef starSheet As Worksheet, _
    ByRef recondoSheet As Worksheet, _
    ByVal srcWkBkName As String) As Boolean
    
    ' Access Querytable defines
    Dim querySheet          As Worksheet
    Dim QT                  As QueryTable
    Dim connStr             As String
    Dim sqlQuery            As String
    Dim lastCol             As String
    Dim success             As Boolean
        
    ' Build the ODBC connection string
    connStr = "ODBC;DSN=MS Access Database;DBQ=G:\Corporate\IS\Share\IS\Rev Cycle IS\"
    connStr = connStr & "System Documentation\Recondo\InventoryRecon\Recondo Recon.accdb"
    
    ' Set default values
    BuildQueryWkBk = True
    success = True
    
    ' Make workbook
    On Error GoTo ErrorHandler
    Set sourceWkBk = Workbooks.Add
    
    With sourceWkBk
        With Application
            .DisplayAlerts = False       ' Suppress "SaveAs" dialog box
            .EnableEvents = False        ' Suppress BeforeSave event
        End With
        On Error Resume Next
        .SaveAs Filename:=srcWkBkName, FileFormat:=xlOpenXMLWorkbook
        On Error GoTo ErrorHandler
        With Application
            .EnableEvents = True
            .DisplayAlerts = True
        End With
    End With
    
'    Set sourceWkBk = ActiveWorkbook
    If Not sourceWkBk Is Nothing And Err.Number = 0 Then
    
        ' Build a QueryTable recipient sheet; can only refresh a querytable on same sheet
        Set querySheet = sourceWkBk.Sheets(1)
        If Not querySheet Is Nothing And Err.Number = 0 And success = True Then
            CreateEpicQuery sqlQuery
            
            With querySheet
                .Name = "QueryTable data"
                .Tab.Color = 65535
            End With
            
            ' Create a querytable based on a query to the Access table
            Set QT = querySheet.QueryTables.Add( _
                Connection:=connStr, _
                Destination:=Range("A1"), _
                Sql:=sqlQuery)
            With QT
                .MaintainConnection = True   ' ADDED FOR TESTING 2nd QUERY
                .BackgroundQuery = True
                .Refresh
            End With
        
            ' Build the EPIC sheet from the query
            Set epicSheet = sourceWkBk.Sheets.Add(After:=Worksheets(Worksheets.Count))
            If Not epicSheet Is Nothing And Err.Number = 0 And success = True Then
                lastCol = "K"
                success = PrepEpicSrcSht(querySheet, epicSheet, lastCol)
                If Not success = True Then
                    GoTo ErrorHandler
                Else
                    With epicSheet
                        .Tab.Color = 255
                    End With
                End If
            End If
        
            ' Build the STAR sheet from the query
            CreateStarQuery sqlQuery
            QT.CommandText = sqlQuery
            QT.Refresh
'            querySheet.QueryTables(1).Refresh
            Set starSheet = sourceWkBk.Sheets.Add(After:=Worksheets(Worksheets.Count))
            If Not starSheet Is Nothing And Err.Number = 0 And success = True Then
                lastCol = "Y"
                success = PrepStarSrcSht(querySheet, starSheet, lastCol)
                If Not success = True Then
                    GoTo ErrorHandler
                Else
                    With starSheet
                        .Tab.Color = 32768
                    End With
                End If
            End If
        
            ' Build the Recondo sheet from the query
            CreateRecondoQuery sqlQuery
            QT.CommandText = sqlQuery
            QT.Refresh
'            querySheet.QueryTables(1).Refresh
            Set recondoSheet = sourceWkBk.Sheets.Add(After:=Worksheets(Worksheets.Count))
            If Not recondoSheet Is Nothing And Err.Number = 0 And success = True Then
                lastCol = "Y"
                success = PrepRecondoSrcSht(querySheet, recondoSheet, lastCol)
                If Not success = True Then
                    GoTo ErrorHandler
                Else
                    With recondoSheet
                        .Tab.Color = 16711680
                    End With
                End If
            End If
        End If
        
'        With querySheet.QueryTables(1)
'            If .Refreshing Then .CancelRefresh
'            ActiveWorkbook.Connections(ActiveWorkbook.Connections.Count).Delete
'        End With
        
    '    querySheet.QueryTables(1).Delete
    '    Set epicQueryTable = Nothing
        On Error GoTo 0
    End If
    
    If success = True Then
        On Error GoTo 0
        Exit Function
    End If
    
ErrorHandler:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Source Workbook Error!"
    On Error GoTo 0
    BuildQueryWkBk = False
End Function

I have also been using a test workbook to try just the simplest query to test just connectivity and methodology, but don't have code I can currently post. The prep functions cut from the querytable and paste to a new sheet, add header information, and format the sheet. I gave up trying to create a querytable on each sheet as futile and too time consuming to take that approach. Office 2013, 64 bit Windows 7 Enterprise

 

[Trevor G]

You can also use DAO which is the older version way to connect to a database. Here is an example of how to get data into a spreadsheet using DAO 3.6 Object Library:

Sub GetData1A()
Dim db As DAO.Database
Dim qryDef As DAO.QueryDef
Dim rcd As DAO.Recordset
Dim fld As DAO.Field
Set db = OpenDatabase("Path and extension.accdb")
Set qryDef = db.QueryDefs("QueryName")
Set rcd = qryDef.OpenRecordset

ThisWorkbook.Worksheets("Sheet2").Range("A2").CopyFromRecordset rcd
i = 0
With Range("A1")
For Each fld In rcd.Fields
.Offset(0, i).Value = fld.Name
i = i + 1
Next fld
End With
End Sub

 

[JimSnyder]

Thanks Trevor. I wish I could. I ended up doing a partial solution from Access:

Option Compare Database
Sub Main()
    DoCmd.TransferText acImport, , "EPIC_source", "\\ds\ce\Corporate\IS\Share\IS\Rev Cycle IS\System Documentation\Recondo\InventoryRecon\EPIC denial data test.csv", -1
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "STAR_source", "\\ds\ce\Corporate\IS\Share\IS\Rev Cycle IS\System Documentation\Recondo\InventoryRecon\STAR denial datatest.xlsx"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Recondo_source", "\\ds\ce\Corporate\IS\Share\IS\Rev Cycle IS\System Documentation\Recondo\InventoryRecon\Recondo Inventorytest.xlsx"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "EPIC_Denial_Data_Without_Matching_Recondo_Inventory", "\\ds\ce\Corporate\IS\Share\IS\Rev Cycle IS\System Documentation\Recondo\InventoryRecon\Output\Monthly_EPIC_Inventory_Recon.xlsx"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "STAR_Denial_Data_Without_Matching_Recondo_Inventory", "\\ds\ce\Corporate\IS\Share\IS\Rev Cycle IS\System Documentation\Recondo\InventoryRecon\Output\Monthly_STAR_Inventory_Recon.xlsx"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Recondo_Inventory_Without_Matching_STAR_Denial_Data", "\\ds\ce\Corporate\IS\Share\IS\Rev Cycle IS\System Documentation\Recondo\InventoryRecon\Output\Monthly_RecondoC_Inventory_Recon.xlsx"
End Sub

This gets the data into the tables, then uses queries to get selected information out. All I have to do is figure out how to automate these.

 

[RoryA]

I'm intrigued - I can't see how a querytable would work but ADO or DAO wouldn't. What code were you using and what happened exactly?

 

[Trevor G]

So these are docmd within Access. If you have them as a macro command in Access then all is required is to open the database and run the macro.

Sub accessMacro()
'Set reference for Access X Object Library
Access As Access.Application
Set appAccess = New Access.Application
appAccess.OpenCurrentDatabase "c:\Access\VBA Excel.mdb"
appAccess.Visible = True
appAccess.DoCmd.RunMacro "Macro Name" 'Change the macro name
appAccess.CloseCurrentDatabase

End Sub

 

[JimSnyder]

@Rory Haven't heard from you in a long time! The code is in the original post. I think I was getting a 1004 error on the second query refresh. I abandoned that approach before completing debugging as my boss needed this "NOW!". Too short a deadline for problem solving and two coworkers who could help me leverage VBA in Access.

@Trevor Much appreciated. Maybe again because of network limitations, it errors out on the "Set appAccess = New Access.Application". The code in a new workbook was:

Option Explicit ' Must declare variables - clean programming technique


Public Sub AccessImport()
'    Dim strDatabasePath As String
'    Dim appAccess As Access.Application
'    strDatabasePath = "C:\DATA\Database1.accdb"
[B][COLOR=#b22222]'    Set appAccess = New Access.Application[/COLOR][/B]
'    With appAccess
'        Application.DisplayAlerts = False
'        .OpenCurrentDatabase strDatabasePath
'        .DoCmd.RunMacro "SampleQuery"
'        .Quit
'    End With
'    Set appAccess = Nothing

Thank you both. I am going to work on calling the module directly from Automate10. I am so used to using Excel as my controller, I bypassed the simpler solutions. <--- big dope!

 

[JimSnyder]

SOLVED:
The inability to set the appAccess object is due to the network being locked down so tight. Ditto for DAO, ADO, and a few other means. Although successfully able to access the Access table using a QueryTable, automation was moved from Excel to AutoMate9 where the files could also be imported into Access and gathered by FTP and file moving.