SQL Select Query - VBA Code - Is there a faster way of writing my code?

[sh1pley]

Hi

I am pulling data from a SQL server and writing this to individual cells on my excel workbook. Everything works fine but I have dozens of SQL lines to write and each time I need to write lots of "Dims" and "Sets"

Is there a quicker/cleaner way of doing this?


VBA Code



Sub Last4WeeksSales()

Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stSQL1 As String
Dim stSQL2 As String
Dim stSQL3 As String
Dim stSQL4 As String
Dim stSQL5 As String

Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnStart1 As Range
Dim rnStart2 As Range
Dim rnStart3 As Range
Dim rnStart4 As Range
Dim rnStart5 As Range

Const stADO As String = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial Catalog=xxxx;Data Source=xx-xx-xx"

Set wbBook = ActiveWorkbook
Set wsSheet = Sheets("Week at a glance")

With wsSheet
Set rnStart1 = .Range("K11")
Set rnStart2 = .Range("I11")
Set rnStart3 = .Range("H11")
Set rnStart4 = .Range("G11")
Set rnStart5 = .Range("F11")

End With

stSQL1 = "select sum(Amount)from crdb.dbo.mSummary_KPI_Report where Type = 'Net Sales Total' and Business_Date > '" & Sheets("Find details").Range("B4") & "' and Business_Date < '" & Sheets("Find details").Range("C4") & "'"
stSQL2 = "select sum(Amount)from crdb.dbo.mSummary_KPI_Report where Type = 'Net Sales Total' and Business_Date >= '" & Sheets("Find details").Range("F4") & "' and Business_Date < '" & Sheets("Find details").Range("B4") & "'"
stSQL3 = "select sum(Amount)from crdb.dbo.mSummary_KPI_Report where Type = 'Net Sales Total' and Business_Date >= '" & Sheets("Find details").Range("G4") & "' and Business_Date < '" & Sheets("Find details").Range("F4") & "'"
stSQL4 = "select sum(Amount)from crdb.dbo.mSummary_KPI_Report where Type = 'Net Sales Total' and Business_Date >= '" & Sheets("Find details").Range("H4") & "' and Business_Date < '" & Sheets("Find details").Range("G4") & "'"
stSQL5 = "select sum(Amount)from crdb.dbo.mSummary_KPI_Report where Type = 'Net Sales Total' and Business_Date >= '" & Sheets("Find details").Range("I4") & "' and Business_Date < '" & Sheets("Find details").Range("H4") & "'"

Set cnt = New ADODB.Connection

With cnt
.CursorLocation = adUseClient
.Open stADO
.CommandTimeout = 0
Set rst1 = .Execute(stSQL1)
Set rst2 = .Execute(stSQL2)
Set rst3 = .Execute(stSQL3)
Set rst4 = .Execute(stSQL4)
Set rst5 = .Execute(stSQL5)

End With

rnStart1.ClearContents
rnStart2.ClearContents
rnStart3.ClearContents
rnStart4.ClearContents
rnStart5.ClearContents

rnStart1.CopyFromRecordset rst1
rnStart2.CopyFromRecordset rst2
rnStart3.CopyFromRecordset rst3
rnStart4.CopyFromRecordset rst4
rnStart5.CopyFromRecordset rst5

rst1.Close
rst2.Close
rst3.Close
rst4.Close
rst5.Close

cnt.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set rst3 = Nothing
Set rst4 = Nothing
Set rst5 = Nothing

Set cnt = Nothing

End Sub

 

[Norie]

One thing you could do is only use reuse the same recordset for all the queries.

Then you would only have one recordset, not five, to deal with.

 

[Kyle123]

Or do all your calls in a single query:

Sub test()Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB.1;User ID=sa;Data Source=Backend;Initial Catalog=zeus"


Sql = "SELECT Top 5 * From Table1; "
Sql = Sql & "Select Top 5 * from Table2; "
Sql = Sql & "Select top 10  * from Table3;"


Set rs = New ADODB.Recordset
rs.Open Sql, cn, adOpenStatic


Debug.Print rs.Fields(0).Value
Set rs = rs.NextRecordset
Debug.Print rs.Fields(0).Value
Set rs = rs.NextRecordset
Debug.Print rs.Fields(0).Value


rs.Close
cn.Close


End Sub