Sample Extracting Data from SQL Server

Replace the server name, user and Pasword with your details.

The column headings are as per the sql. The rows are inserted after the headings. If there are a large number of rows use a Long variable for the row number

Sub Main(Name As String)
    
    Dim SQLCon As New ADODB.Connection
    Dim Rs As New ADODB.Recordset
    Dim Cmd As ADODB.Command
    Dim SQLStr As String
    Dim ConStr As String
    Dim i As Integer
    Dim fType As String
    
    Set SQLCon = New ADODB.Connection
    ConStr = “Provider=SQLOLEDB;Data Source=ServerName;Initial Catalog=DBName;” & _
             “User Id=username;Password=Password;”
    SQLCon.ConnectionString = ConStr
    SQLCon.Open
    
    
    
    Rs.CursorType = adOpenForwardOnly
    
    SQLStr = “SELECT Heat.CallLog.CallID AS [Heat Call No], Heat.CallLog.CallDesc AS     Description, “ + _
    ”(RTRIM(Heat.Profile.FirstName) + ‘ ‘ + RTRIM(Heat.Profile.LastName)) as Client, “ +     _
    ”Heat.Profile.Phone as Phone_No FROM  Heat.CallLog INNER JOIN “ + _
    ”Heat.Asgnmnt ON Heat.CallLog.CallID = Heat.Asgnmnt.CallID INNER JOIN “ + _
    ”Heat.Assignee ON Heat.Asgnmnt.Assignee = Heat.Assignee.Assignee “ + _
    ”INNER JOIN Heat.Profile ON Heat.CallLog.CustId = Heat.Profile.Custid “
    SQLStr = SQLStr + “WHERE  (Heat.Asgnmnt.Resolution NOT IN (‘Completed’, ‘Reassigned’)     OR “ + _
    ”Heat.Asgnmnt.Resolution IS NULL) AND (Heat.Asgnmnt.Assignee LIKE ‘” + Name + “%’)”
    
    Debug.Print SQLStr
    Rs.Open SQLStr, SQLCon
    
    
    
    Sheets(“Sheet1”).Select
    lRow = 3
    For i = 0 To (Rs.Fields.Count - 1)
        ActiveSheet.Cells(1, i + 1).Value = Rs.Fields(i).Name
    Next
    
    While Not Rs.EOF
        For i = 0 To (Rs.Fields.Count - 1)
          fType = Rs.Fields(i).Type
          If Rs.Fields(i).Value <> vnNull Then
            If fType = “131” Then
               dValue = Rs.Fields(i).Value
               ActiveSheet.Cells(lRow, i + 1).Value = Format(dValue, “#########0”)
            Else
                ActiveSheet.Cells(lRow, i + 1).Value = Rs.Fields(i).Value
            End If
          End If
        Next
    
          
        Rs.MoveNext
        lRow = lRow + 1
          
    Wend
    
    Rs.Close
    
End Sub