Excel VBA: Create dynamic worksheet from SQL Query / Excel Arbeitsblatt durch SQL Query erstellen

Problem

A new Worksheet should be created, that contains the result of an SQL Query (ADODB) generic (in the way, that no column names have to be adressed in the recordset.

Approach – Ansatz

  • Iteration over the Resultsets field names to get Meta Information / Header names
  • Usage of CopyFromRecordSet method of the Range Object: worksheet.Range(„A2“).CopyFromRecordset Rs

Solution – Lösung

Sub CreateExcelSheetWithQueryResult(ws As Worksheet, sql As String)
    Dim Cn As New ADODB.Connection
    Dim Rs As New ADODB.Recordset
    Dim vaTmp() As String
    
    Cn.Provider = "SQLOLEDB.1"
    
    Cn.ConnectionString = "Password=pass;" & _
    "Persist Security Info=True;" & _
    "User ID=user;" & _
    "Initial Catalog=databaseName;" & _
    "Data Source=ServernameOrIP"
    
    Cn.Open
    
    Rs.CursorType = adOpenKeyset
    Rs.LockType = adLockPessimistic
    Rs.Open sql, Cn, adOpenStatic
   
    ws.Cells.Clear
    
    ' This section fills in the field names from the Orders table.
    ReDim vaTmp(Rs.Fields.Count)
    For x = 0 To Rs.Fields.Count - 1
        vaTmp(x) = Rs.Fields(x).Name
    Next
    ws.Cells(1, 1).Resize(1, Rs.Fields.Count) = vaTmp
   
    ws.Range("A2").CopyFromRecordset Rs
    
    Rs.Close
    Cn.Close
End Sub

And if you want to create a new Excel sheet you can do this with a button that assigned macro contains the following source:

Sub DetailQuery1_KlickenSieAuf()
    Dim ws As Worksheet
    Sheets.Add After:=Sheets(Sheets.Count)
    ' Referenz darauf
    Set ws = Sheets(Sheets.Count)
    CreateExcelSheetWithQueryResult ws, "SELECT TOP 10 * FROM irrsinn"
    
End Sub

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert

Diese Website verwendet Akismet, um Spam zu reduzieren. Erfahre mehr darüber, wie deine Kommentardaten verarbeitet werden.