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.
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
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.
Code:
'################################################################################
'## 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