Hi
I'm new to using List Objects and Query Tables in VBA, and have been using some of the many tips I've found through Google, but I'm a bit stuck now.
I am writing some VBA to:
check if a List Object Query Table already exists
if it doesn't, I want to create it using passed SQL and Connection parameters, and assigning a name to it
if it does, then I want to refresh it but using updated SQL
The SQL includes a date criteria in the WHERE clause, so I can pull the current month's data into my ListObject.
I have been able to set up the List Object's QueryTable but for the life of me can't seem to get my VBA code right to refresh the query with the updated SQL text.
Here's what I have at the moment (it''s likely it's a bit all over the place as I've recycled some public code and trying to understand it as I go):
Option Explicit
Public cnnConnect As ADODB.Connection 'connection
Public rstRecordset As ADODB.Recordset 'record set returned by query
Public shtInp As Worksheet 'pointer to the Input sheet
Public rngQry As Range 'pointer to the Query table
Public qryTable As QueryTable 'pointer to List Object Query Table
Public lobList As ListObject 'pointer to the query's List Object
Public strConnection As String 'connection string
Public strSQLCode As String 'SQL code to be run
Public strTblName As String 'name allocated to the table
Sub GetAgedWIPData()
Set shtInp = Worksheets("Aged WIP data")
Set rngQry = shtInp.Range("A3")
strConnection = "Provider=SQLOLEDB;" & _
"Server=AU-AUSAPP074;" & _
"Database=MRCReports;" & _
"Trusted_Connection=Yes"
strSQLCode = Range("WiPByPtrQuery")
strSQLCode = Replace(strSQLCode, "[ToDate]", Format(Range("ToDate"), "YYYY-MM-DD"))
strSQLCode = Replace(strSQLCode, "[PriorMonthDate]", Format(Range("PriorMonthDate"), "YYYY-MM-DD"))
strSQLCode = Replace(strSQLCode, "[PriorYearDate]", Format(Range("PriorYearDate"), "YYYY-MM-DD"))
strSQLCode = Replace(strSQLCode, "[CurrentLoS]", Range("CurrentLoS"))
strTblName = "lstAgedWIP"
Call QueryToList(strConnection, strSQLCode, shtInp, rngQry, strTblName)
End Sub
Sub QueryToList(strConn, strSQL, sht, rng, Optional strNm)
'strConn = connection string
'strSQL = SQL code
'sht = the sheet where the List Object resides|will reside
'rng = range where the List is located on the sht
'strNm = the name of the List (optional: only for new List)
Set cnnConnect = CreateObject("ADODB.Connection")
Set rstRecordset = CreateObject("ADODB.Recordset")
'if the list exists, assign it to the pointer; else it remains Nothing
On Error Resume Next
Set qryTable = sht.ListObjects(strNm).QueryTable
On Error GoTo 0
'open the connection and recordset
cnnConnect.Open strConn
rstRecordset.Open strSQL, cnnConnect
If qryTable Is Nothing Then
'add a new Query Table List Object
Set qryTable = sht.ListObjects.Add( _
SourceType:=xlSrcQuery, _
Source:=rstRecordset, _
XlListObjectHasHeaders:=True, _
Destination:=rng).QueryTable
With qryTable
.FillAdjacentFormulas = True
.PreserveFormatting = True
.AdjustColumnWidth = False
.ListObject.Name = strNm
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
Else 'just refresh it
With qryTable
.CommandText = strSQL
.CommandType = xlCmdSql
.Refresh 'BackgroundQuery:=False
End With
End If
'close the connection & recordset, then remove them
rstRecordset.Close
cnnConnect.Close
Set rstRecordset = Nothing
Set cnnConnect = Nothing
End Sub
Any advice would be gratefully accepted; I'm getting to the point of putting it in the 'too hard basket' 8-(
Thanks in advance,
PJ
I'm new to using List Objects and Query Tables in VBA, and have been using some of the many tips I've found through Google, but I'm a bit stuck now.
I am writing some VBA to:
check if a List Object Query Table already exists
if it doesn't, I want to create it using passed SQL and Connection parameters, and assigning a name to it
if it does, then I want to refresh it but using updated SQL
The SQL includes a date criteria in the WHERE clause, so I can pull the current month's data into my ListObject.
I have been able to set up the List Object's QueryTable but for the life of me can't seem to get my VBA code right to refresh the query with the updated SQL text.
Here's what I have at the moment (it''s likely it's a bit all over the place as I've recycled some public code and trying to understand it as I go):
Option Explicit
Public cnnConnect As ADODB.Connection 'connection
Public rstRecordset As ADODB.Recordset 'record set returned by query
Public shtInp As Worksheet 'pointer to the Input sheet
Public rngQry As Range 'pointer to the Query table
Public qryTable As QueryTable 'pointer to List Object Query Table
Public lobList As ListObject 'pointer to the query's List Object
Public strConnection As String 'connection string
Public strSQLCode As String 'SQL code to be run
Public strTblName As String 'name allocated to the table
Sub GetAgedWIPData()
Set shtInp = Worksheets("Aged WIP data")
Set rngQry = shtInp.Range("A3")
strConnection = "Provider=SQLOLEDB;" & _
"Server=AU-AUSAPP074;" & _
"Database=MRCReports;" & _
"Trusted_Connection=Yes"
strSQLCode = Range("WiPByPtrQuery")
strSQLCode = Replace(strSQLCode, "[ToDate]", Format(Range("ToDate"), "YYYY-MM-DD"))
strSQLCode = Replace(strSQLCode, "[PriorMonthDate]", Format(Range("PriorMonthDate"), "YYYY-MM-DD"))
strSQLCode = Replace(strSQLCode, "[PriorYearDate]", Format(Range("PriorYearDate"), "YYYY-MM-DD"))
strSQLCode = Replace(strSQLCode, "[CurrentLoS]", Range("CurrentLoS"))
strTblName = "lstAgedWIP"
Call QueryToList(strConnection, strSQLCode, shtInp, rngQry, strTblName)
End Sub
Sub QueryToList(strConn, strSQL, sht, rng, Optional strNm)
'strConn = connection string
'strSQL = SQL code
'sht = the sheet where the List Object resides|will reside
'rng = range where the List is located on the sht
'strNm = the name of the List (optional: only for new List)
Set cnnConnect = CreateObject("ADODB.Connection")
Set rstRecordset = CreateObject("ADODB.Recordset")
'if the list exists, assign it to the pointer; else it remains Nothing
On Error Resume Next
Set qryTable = sht.ListObjects(strNm).QueryTable
On Error GoTo 0
'open the connection and recordset
cnnConnect.Open strConn
rstRecordset.Open strSQL, cnnConnect
If qryTable Is Nothing Then
'add a new Query Table List Object
Set qryTable = sht.ListObjects.Add( _
SourceType:=xlSrcQuery, _
Source:=rstRecordset, _
XlListObjectHasHeaders:=True, _
Destination:=rng).QueryTable
With qryTable
.FillAdjacentFormulas = True
.PreserveFormatting = True
.AdjustColumnWidth = False
.ListObject.Name = strNm
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
Else 'just refresh it
With qryTable
.CommandText = strSQL
.CommandType = xlCmdSql
.Refresh 'BackgroundQuery:=False
End With
End If
'close the connection & recordset, then remove them
rstRecordset.Close
cnnConnect.Close
Set rstRecordset = Nothing
Set cnnConnect = Nothing
End Sub
Any advice would be gratefully accepted; I'm getting to the point of putting it in the 'too hard basket' 8-(
Thanks in advance,
PJ