How to extract data from SQL Server database and display it with Microsoft Excel and VBA

gistfile1.txt

Public Sub GetData_from_SQLServerDatabase_with_VBA_Excel()
 Dim strConnectionString As String, strQuery As String, strMessage As String
 Dim objConn As ADODB.Connection
 Dim rsData As ADODB.Recordset

 Dim varArrayReader As Variant
 Dim intLBoundColumn As Integer, intUBoundColumn As Integer ' this variable is meant to hold the lower and upper indexes of the 1st dimension of the Array (columns)
 Dim intLBoundRow As Integer, intUBoundRow As Integer  ' this variable is meant to hold the lower and upper indexes of the 2nd dimension of the Array (rows)
 
 Dim i As Integer, j As Integer
 
 strConnectionString = "Provider=SQLOLEDB;Data Source=your-database-server;Initial Catalog=your-initial-catalog;User ID=your-database-user;Password=your-database-password"
        
    strQuery = ""
    strQuery = strQuery & "SELECT " & vbCrLf
    strQuery = strQuery & " 'yourschema.tableid.column_1' AS [First column], " & vbCrLf
    strQuery = strQuery & " " & vbCrLf
    strQuery = strQuery & " 'yourschema.tableid.column_2' AS [Second column], " & vbCrLf
    strQuery = strQuery & " " & vbCrLf
    strQuery = strQuery & " CASE 'yourschema.tableid.column_3' " & vbCrLf
    strQuery = strQuery & "     WHEN '9' THEN 'Closed' " & vbCrLf
    strQuery = strQuery & "     WHEN '8' THEN 'Completed' " & vbCrLf
    strQuery = strQuery & "     WHEN '7' THEN 'To be Completed' " & vbCrLf
    strQuery = strQuery & "     WHEN '6' THEN 'Active' " & vbCrLf
    strQuery = strQuery & "     WHEN '4' THEN 'Released' " & vbCrLf
    strQuery = strQuery & "     WHEN '3' THEN 'Documents Printed' " & vbCrLf
    strQuery = strQuery & "     WHEN '1' THEN 'Planned' " & vbCrLf
    strQuery = strQuery & "     ELSE  'Other Status' " & vbCrLf
    strQuery = strQuery & " END AS [Third column], " & vbCrLf
    strQuery = strQuery & " " & vbCrLf
    strQuery = strQuery & " " & vbCrLf
    strQuery = strQuery & " 'yourschema.tableid.column_4' AS [Fourth column], " & vbCrLf
    strQuery = strQuery & " " & vbCrLf
    strQuery = strQuery & " 'yourschema.tableid.column_5' AS [Fifth column], " & vbCrLf
    strQuery = strQuery & " " & vbCrLf
    strQuery = strQuery & "  'yourschema.tableid.column_6' AS [Sixth column] " & vbCrLf
    strQuery = strQuery & " FROM  'yourschema.tableid" & vbCrLf
   
    
    Set objConn = New ADODB.Connection
    objConn.Open strConnectionString
    Set rsData = New ADODB.Recordset
    rsData.Open strQuery, objConn
    
    varArrayReader = rsData.GetRows
    intLBoundColumn = LBound(varArrayReader, 1)
    intUBoundColumn = UBound(varArrayReader, 1)
    intLBoundRow = LBound(varArrayReader, 2)
    intUBoundRow = UBound(varArrayReader, 2)
    
    With ThisWorkbook.Sheets(9)
        .Activate
        'Rows("2:" & Rows.Count).ClearContents 'varianta in care Range-ul este convertit in Table. Durata mare de executie a extragerii de date din baza de date !!!! :(
        .Cells.Clear
    End With
    
    For i = 0 To intUBoundRow
       With ActiveSheet
         .Range("A" & i + 2).Value = varArrayReader(0, i)  'Display Column 1
         .Range("B" & i + 2).Value = varArrayReader(1, i)  'Display Column 2
         .Range("C" & i + 2).Value = varArrayReader(2, i) 'Display Column 3
         .Range("D" & i + 2).Value = varArrayReader(3, i) 'Display Column 4
         .Range("E" & i + 2).Value = varArrayReader(4, i) 'Display Column 5
         .Range("F" & i + 2).Value = varArrayReader(5, i) 'Display Column 6
       End With
    Next
    
    With ActiveSheet
        .Range("A1").Value = "Header Column 1"
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = 12
        
        .Range("B1").Value = "Header Column 2"
        .Range("B1").Font.Bold = True
        .Range("B1").Font.Size = 12
        
        .Range("C1").Value = "Header Column 3"
        .Range("C1").Font.Bold = True
        .Range("C1").Font.Size = 12
        
        .Range("D1").Value = "Header Column 4"
        .Range("D1").Font.Bold = True
        .Range("D1").Font.Size = 12
        
        .Range("E1").Value = "Header Column 5"
        .Range("E1").Font.Bold = True
        .Range("E1").Font.Size = 12
        
        .Range("F1").Value = "Header Column 6"
        .Range("F1").Font.Bold = True
        .Range("F1").Font.Size = 12      
    End With
    
    
    strMessage = MsgBox("I have extracted the data from SQL Database", vbOKOnly, "Succes!")