1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
|
Sub RunQuery(WkSheetName As String, sSQL As String)
Dim wsSheet As Worksheet
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim iCol_nbr As Integer
' Connection Parameters
Dim stADO As String
stADO = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=False;" & _
"Initial Catalog=" + ActiveWorkbook.Sheets("App_Form").Range("B3").Value + ";" & _
"Data Source=" + ActiveWorkbook.Sheets("App_Form").Range("B2").Value
' Cleanup OLD Data
CleanWorkSheet WkSheetName, "Yes"
' Worksheet Definition
Set wsSheet = ActiveWorkbook.Sheets(WkSheetName)
' Creating the connection
Set cnt = New ADODB.Connection
' Executing the SQL query
With cnt
.CursorLocation = adUseClient
.Open stADO
.CommandTimeout = 0
Set rst = .Execute(sSQL)
End With
ActiveWorkbook.Sheets(WkSheetName).Range("A1").Value = "Rows Count"
ActiveWorkbook.Sheets(WkSheetName).Range("B1").Value = rst.RecordCount
' Adding column names in the first row
iCol_nbr = 1
For Each fld In rst.Fields
ActiveWorkbook.Sheets(WkSheetName).Cells(2, iCol_nbr).Value = fld.Name
iCol_nbr = iCol_nbr + 1
Next
' Adding the Recordset to the sheet from A2
ActiveWorkbook.Sheets(WkSheetName).Range("A3").CopyFromRecordset rst
' Look and feel update
ActiveWorkbook.Sheets(WkSheetName).Select
ActiveWindow.Zoom = 50
ActiveWorkbook.Sheets(WkSheetName).Cells.EntireColumn.AutoFit
ActiveWorkbook.Sheets(WkSheetName).Cells.EntireRow.AutoFit
ActiveWorkbook.Sheets(WkSheetName).Range("A1").Select
' Cleaning up.
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
End Sub |
Partager