anyQuery2Excel.vbs

I wrote a small VBS script which will execute any SELECT statement or stored procedure against a SQL database and returns the result in an Excel sheet.

'anyQuery2Excel.vbs
'Runs a query against a SQL database and returns 
'the result in an Excel sheet
'Frederik Vandeputte - http://www.vandeputte.org
'Based on Scripted Server Snapshot by  Roy Carlson
'See also http://www.sqlservercentral.com/columnists
'/rcarlson/scriptedserversnapshot.asp
'Thanks to Robert Paquette for the copyFromRecordSet tip
'On Error Resume Next
Const adOpenStatic = 3
Const adLockOptimistic = 3
Dim c
Dim r
Dim sql
Dim conString

'
'Change the value of the following vars
'
sql = "select * from sysdatabases"
conString = "Provider = SQLOLEDB;Data Source=(local);" & _
        "Trusted_Connection=Yes;Initial Catalog=Master;"


' making the connection to your sql server
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")

objConnection.Open conString

' creating the Excel object application
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)

' Execute the query
objRecordSet.Open sql, objConnection, adOpenStatic, adLockOptimistic
'
'Get the column headers
'
c = 1
If Not objRecordSet.EOF Then
    For Each col In objRecordSet.Fields
        objExcel.Cells(1, c).Value = col.Name
        objExcel.Cells(1, c).Font.Bold = True
        c = c + 1
    Next
Else
    objExcel.Cells(1, c).Value = "Query returned no results"
End If
'
'Get the rows
'
objWorksheet.Range("A2").CopyFromRecordset objRecordSet
'
'Use the loop below if CopyFromRecordset gives problems
'
'r = 2
'Do While Not objRecordSet.EOF
'    c = 1
'      For Each col In objRecordSet.Fields
'        objExcel.Cells(r, c).Value = objRecordSet.Fields.Item(c - 1).Value
'        c = c + 1
'    Next
'    r = r + 1
'    objRecordSet.MoveNext
'Loop


' automatically fits the data to the columns
Set objRange = objWorksheet.UsedRange
objRange.Select
objRange.EntireColumn.AutoFit
objRange.AutoFilter

' cleaning up
objRecordSet.Close
objConnection.Close