Importing Multiple RecordSets into QueryTables on a single sheet

[jmaccab3]

Hello,

I have written some VBA code (below) that sets up an external data connection in a workbook, queries a stored SQL procedure on an external server and imports the resulting recordset into a QueryTable.

However, I have a stored procedure saved on a server that contains two select statements and therefore produces two distinct tables with different headers. The code as it's written can't bring in the multiple recordsets generated by the same command.

Anybody have any thoughts as to how the VBA can be modified to accommodate the two RecordSets? Any help would be much appreciated!

Thanks!

-------------------------------------

Sub openCxn(ByRef ProcNumber As Integer)
Dim oTbl As ListObject
Dim serverName As String
Dim initialCatalog As String
Dim parameterString As String
Dim cxnPath As String
Dim cmdStr As String
Dim cxnStr As String
Dim procName As String
Dim i As Double
Dim j As Double
Dim resp As Integer
On Error GoTo ErrHandler


serverName = "xxx"
initialCatalog = "DB"
parameterString = "params"
procName = "schema.stored_procedure_name"
cmdStr = "exec schema.stored_procedure_name "
cxnStr = "OLEDB;Provider=SQLOLEDB" & _
";Initial Catalog=" & initialCatalog & _
";Integrated Security=sspi" & _
";Data Source=" & serverName

ActiveWorkbook.EnableConnections


i = ActiveWorkbook.Worksheets.Count
j = 1


If ActiveWorkbook.Connections("cxn_" & procName) Is Nothing Then
ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = procName
Set oSht = ActiveWorkbook.Sheets(procName)

With oSht.ListObjects.Add(SourceType:=0, _
Source:=cxnStr, _
Destination:=Range("$A$1") _
).QueryTable
.CommandType = xlCmdDefault
.CommandText = cmdStr & parameterString
.ListObject.DisplayName = "Tbl_" & procName
.Refresh BackgroundQuery:=False
.PreserveColumnInfo = False
End With


Application.Wait (Now + TimeValue("0:00:01"))

ActiveWorkbook.Connections.Item(1).Name = "cxn_" & procName


Else


For j = 1 To i
If ActiveWorkbook.Worksheets(j).ListObjects.Count <> 0 Then
Set oSht = ActiveWorkbook.Worksheets(j)
If oSht.ListObjects(1).Name <> oSht.ListObjects("Tbl_" & procName) Then
Else
With oSht.ListObjects("Tbl_" & procName)
.QueryTable.CommandText = cmdStr & parameterString
.Refresh
End With
i = 1
j = 1
Exit Sub
End If
Else
End If
Next j

End If


i = 1
j = 1


Exit Sub


ErrHandler:


If Err.Number = 9 Then
Resume Next
End If


Application.ScreenUpdating = True
MsgBox Err.Number & vbCrLf & Err.Description


Exit Sub


End Sub