Twitter Updates

    follow me on Twitter

    Tuesday, July 19, 2005

    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

    No comments: