Results should Always populate the same worksheet named ProjectResults

Option Explicit

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset

Sub Connect_To_SQLServer(ByVal Server_Name As String, ByVal Database_Name As String, ByVal SQL_Statement As String)

    Dim strConn As String
    Dim wsReport As Worksheet
    Dim col As Integer
    Dim OutputWsName As String
    
    OutputWsName = "ProjectResults"
    
    strConn = "Provider=SQLOLEDB;"
    strConn = strConn & "Server=" & Server_Name & ";"
    strConn = strConn & "Database=" & Database_Name & ";"
    strConn = strConn & "Trusted_Connection=yes;"
    
    Set conn = New ADODB.Connection
    
    With conn
            .Open ConnectionString:=strConn
            .CursorLocation = adUseClient
    End With
    
    Set rst = New ADODB.Recordset
    
    With rst
            .ActiveConnection = conn
            .Open Source:=SQL_Statement
    End With
    
    'Delete existing output
    deleteWorkSheet OutputWsName
    
    Set wsReport = ThisWorkbook.Worksheets.Add
    wsReport.Name = OutputWsName
    
    With wsReport
            For col = 0 To rst.Fields.Count - 1
                    .Cells(1, col + 1).Value = rst.Fields(col).Name
            Next col
    
            .Range("A2").CopyFromRecordset rst
    End With
    
    Set wsReport = Nothing
    
    Call Close_Connections

End Sub

Private Sub Close_Connections()

    If rst.State <> 0 Then rst.Close
    If conn.State <> 0 Then conn.Close
     
    '// Release Memory
    Set rst = Nothing
    Set conn = Nothing

End Sub

Sub Run_Report()
    
    Dim Server_Name As String
    
    Server_Name = "CLDGP2018TEST\DEV"
    
    Call Connect_To_SQLServer(Server_Name, "MED", "SELECT PAPROJNUMBER Project_Number, REQDATE Required FROM PA01303 WHERE PA01303.REQDATE >CONVERT(DATE, '2008-07-16', 102)")

End Sub

Function deleteWorkSheet(ByVal WsName As String) As Boolean
    On Error GoTo EH
    For Each ws In ThisWorkbook.Sheets
        If ws.Name = WsName Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
            deleteWorkSheet = True
            Exit Function
        End If
    Next
    deleteWorkSheet = False
    Exit Function
EH:
    deleteWorkSheet = False
End Function

Select allOpen in new window