Public Sub RunReport()
    Call rpt.CreateReport(rID)
End Sub

Private WithEvents cn As ADODB.Connection

'процедура формирования отчета
Public Sub CreateReport(id As String)
    Dim cmd As ADODB.Command
    
    On Error GoTo EH
    
    'открываем конекшн
    Set cn = New ADODB.Connection
    cn.ConnectionString = "Моя строка подключения" 'строка соединения
    cn.CursorLocation = adUseClient
    cn.CommandTimeout =  0 
    cn.Open
    
    Set cmd = New ADODB.Command
    Dim par As ADODB.Parameter
    
    'создаем объект комманд
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = cn
    cmd.CommandTimeout =  0 
    cmd.CommandType = adCmdStoredProc
    
    'создаем и добавляем параметр
    Set par = cmd.CreateParameter("@id", adVarChar, adParamInput,  100 , id)
    'par.Value = id
    cmd.Parameters.Append par

    'запускаем асинхронное выполнение
    cmd.CommandText = "dbo.Моя_ХП"
    cmd.Execute , , adAsyncExecute           'adCmdStoredProc + adAsyncFetch + adAsyncFetchNonBlocking + adAsyncExecute
    
    Exit Sub
EH:
    'обработчик ошибки
    CloseAll
End Sub

'запрос выполнился
Private Sub cn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
    If pError Is Nothing Then
        MakeReport pRecordset
    Else
        ThisWorkbook.Worksheets( 1 ).Range("A1") = pError
        ThisWorkbook.Worksheets( 1 ).Name = "Done"
        CloseAll
    End If
End Sub

DECLARE PROCEDURE dbo.Моя_ХП() AS
BEGIN
  SET NOCOUNT ON
  SET ANSI_WARNINGS OFF

  ...
END
GO

Dim cmd As ADODB.Command

Private cmd As ADODB.Command

CopyFromRecordset

While not rs.EOF
...
End While