nikkay1
05-04-2017, 08:03 AM
Hi folks, currently working on some automation at work where we have written a script to pull specific data and automatically import into Excel. This code will also run under a For Each statement later on and run through the same code for a number of different client databases.
Basically I have come up with the code below which does what I need with regards to running a basic query and returning the results in the format I need; however, the SQL query has become a little more complicated in that I now need to include a where clause which includes over 4000 individual numbers which will change from month to month! We came up with the solution that we will simply split the SQL query in two, paste the 4000+ numbers into column R on the spreadsheet and concatenate them all in VBA.
Now in testing for a single client, this works a treat as long as column R has less than around 4400 entries (R2:R4402) - we tested low numbers and gradually increased until we got to the 4400 mark (this is approximate - still testing to find the specific threshold). Anything under the 4400 mark produced instant results with very little load time. The moment we breached this threshold, Excel locked up. I'm thinking it could be that the concatenation results in the overall string exceeding a character limit (it's worth noting that each of the numbers in the where clause are 12 digits long, plus commas and apostrophes).
Any ideas?
Option Explicit
Sub Add_SQLTable()
Dim c as concat
Dim n As Name
Dim sht As String
Dim sHostName As String
Dim cnt As ADODB.Connection, rst As ADODB.Recordset
Dim stSQL As String
Dim qtData As QueryTable, wbBook As Workbook, wsSheet As Worksheet, rnStart As Range
Dim username As String, password As String, eleccatalog As String, gascatalog As String, ipaddress As String
Dim stADO As String
sHostName = Environ$("computername")
Range("workstationID").Value = sHostName
username = Range("username").Value
password = Range("password").Value
eleccatalog = Range("eleccatalog").Value
gascatalog = Range("gascatalog").Value
ipaddress = Range("ipaddress").Value
stADO = "Provider=SQLOLEDB;Password=" & password & ";Persist Security Info=True;" & _
"User ID=" & username & ";Initial Catalog =" & eleccatalog & ";Data Source=" & ipaddress & ";" & _
"Workstation ID=" & sHostName & ";UserEncryption for Data=False;" & _
"Tag with column collation when possible=False"
Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
With wsSheet
Set rnStart = wsSheet.Range("A1")
End With
concat = Join(Application.Transpose(Range("R2:R4500")), "")
stSQL = wbBook.Worksheets("Admin").Range("Script").Value & concat & wbBook.Worksheets("Admin").Range("Script2").Value
Set cnt = New ADODB.Connection
With cnt
.CursorLocation = adUseClient
.Open stADO
.CommandTimeout = 0
Set rst = .Execute(stSQL)
End With
Set qtData = wsSheet.QueryTables.Add(rst, rnStart)
With qtData
.FieldNames = False
.Refresh
End With
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
sht = "Sheet1"
For Each n In ActiveWorkbook.Names
If n.RefersToRange.Worksheet.Name = sht Then
n.Delete
End If
Next n
End Sub
Basically I have come up with the code below which does what I need with regards to running a basic query and returning the results in the format I need; however, the SQL query has become a little more complicated in that I now need to include a where clause which includes over 4000 individual numbers which will change from month to month! We came up with the solution that we will simply split the SQL query in two, paste the 4000+ numbers into column R on the spreadsheet and concatenate them all in VBA.
Now in testing for a single client, this works a treat as long as column R has less than around 4400 entries (R2:R4402) - we tested low numbers and gradually increased until we got to the 4400 mark (this is approximate - still testing to find the specific threshold). Anything under the 4400 mark produced instant results with very little load time. The moment we breached this threshold, Excel locked up. I'm thinking it could be that the concatenation results in the overall string exceeding a character limit (it's worth noting that each of the numbers in the where clause are 12 digits long, plus commas and apostrophes).
Any ideas?
Option Explicit
Sub Add_SQLTable()
Dim c as concat
Dim n As Name
Dim sht As String
Dim sHostName As String
Dim cnt As ADODB.Connection, rst As ADODB.Recordset
Dim stSQL As String
Dim qtData As QueryTable, wbBook As Workbook, wsSheet As Worksheet, rnStart As Range
Dim username As String, password As String, eleccatalog As String, gascatalog As String, ipaddress As String
Dim stADO As String
sHostName = Environ$("computername")
Range("workstationID").Value = sHostName
username = Range("username").Value
password = Range("password").Value
eleccatalog = Range("eleccatalog").Value
gascatalog = Range("gascatalog").Value
ipaddress = Range("ipaddress").Value
stADO = "Provider=SQLOLEDB;Password=" & password & ";Persist Security Info=True;" & _
"User ID=" & username & ";Initial Catalog =" & eleccatalog & ";Data Source=" & ipaddress & ";" & _
"Workstation ID=" & sHostName & ";UserEncryption for Data=False;" & _
"Tag with column collation when possible=False"
Set wbBook = ActiveWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")
With wsSheet
Set rnStart = wsSheet.Range("A1")
End With
concat = Join(Application.Transpose(Range("R2:R4500")), "")
stSQL = wbBook.Worksheets("Admin").Range("Script").Value & concat & wbBook.Worksheets("Admin").Range("Script2").Value
Set cnt = New ADODB.Connection
With cnt
.CursorLocation = adUseClient
.Open stADO
.CommandTimeout = 0
Set rst = .Execute(stSQL)
End With
Set qtData = wsSheet.QueryTables.Add(rst, rnStart)
With qtData
.FieldNames = False
.Refresh
End With
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
sht = "Sheet1"
For Each n In ActiveWorkbook.Names
If n.RefersToRange.Worksheet.Name = sht Then
n.Delete
End If
Next n
End Sub