Excel VBA and SQL stored procedure with multiple data sets

[dfuas]

Hi All

I have an established SP that generates multiple data sets. I can get at the first dataset but not all the others.

Does anyone knows if it is possible and how to get all the other data sets.

I am using Excel 2007 VBA and some of the code is as follows:

Also how can I save the query so that I can refresh this when needed. I used to be able to do it on Excel 2000 & 2003 but 2007 seems quite a different beast.

Thanks

df

 'refresh queries on each tab
    With TemplateBook.Sheets("Quality Review").Range("A8").QueryTable
       .CommandText = "EXEC s_ProcTable @TableName = '" & strTables & "'"
       .Refresh BackgroundQuery:=False
    End With

[His Nibbs]

If you're using ADODB, use a loop like this:

    Do
        Do While Not adoRS.EOF
            'Output data from result set
            Range("A1").Offset(row, 0).CopyFromRecordset adoRS
            row = row + adoRS.RecordCount + 2
        Loop
        'Move to next result set
        Set adoRS = adoRS.NextRecordset()
    Loop Until adoRS Is Nothing

For your question about saving a query, try creating it with the Macro recorder to get the VBA. With Excel 2007, the QueryTable is a member of a ListObject - see http://www.ozgrid.com/forum/showthread.php?t=89168

[dfuas]

Thank you for your reply, but I am failing to get how this will fit into my code which is given below:

The first part looks at any tablenames on a combo box

the second part is meant to extract all the data based on a combo box value selected on part 1, if none is selected the displays for all on different worksheets.

Part 1

Sub Run_All()

    Dim ConnectionString As String
  
    ConnectionString = "ODBC;Description=Report;DRIVER=SQL Server;SERVER=ION;APP=Microsoft Open Database Connectivity;DATABASE=Test_DEV;Trusted_Connection = Yes"


    Sheets("Quality Review").Visible = True
    Sheets("Findings Section").Visible = True
    
    Dim adoTableName As New ADODB.Connection
    Dim strSQL As String
    Dim rstTables As ADODB.Recordset
    
    adoTableName.ConnectionString = ConnectionString
    adoTableName.Open
    adoTableName.CommandTimeout = 0
    
    
    If shtStart.ComboBox1.Value = "TableName" Then
       strSQL = "SELECT name FROM sys.objects where type = 'U' order by name"
    Else
       strSQL = "SELECT name FROM sys.objects where type = 'U' and name = '" & shtStart.ComboBox1.Value & "'"
    End If
   
    Set rstTables = adoTableName.Execute(strSQL)
   
    
    With rstTables
       .MoveFirst
       While Not .EOF
          Create_New_Table rstTables!Name, ActiveWorkbook
          .MoveNext
       Wend
       
       Sheets("Start").Select
       
       .Close
    End With
    
    adoTableName.Close

    Sheets("Quality Review").Visible = False
    Sheets("Findings Section").Visible = False
    
End Sub

Part 2

Sub Create_New_Table(ByVal strTables As String, TemplateBook As Workbook)

    Dim newBook As Workbook
    Dim ConnectionString As String
 
    
    ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Test_DEV;Data Source=ION"
    
    Set newBook = Workbooks.Add
    
    TemplateBook.Activate
    
    'set region labels for each of the tabs in the template workbook
    TemplateBook.Sheets("Quality Review").Range("C4").Value = strTables
    TemplateBook.Sheets("Quality Review").Range("C5").Value = Format(Sheets("Start").Range("G17").Value, "dd-mmm-yyyy")
 
   
    
    'refresh queries on each tab
    With TemplateBook.Sheets("Quality Review").Range("A8").QueryTable
       .CommandText = "EXEC s_ProcTable @TableName = '" & strTables & "'"
       .Refresh BackgroundQuery:=False
    End With
    
     
    'now copy the refreshed template worksheets to the new workbook
    TemplateBook.Sheets("Regional Reports").Copy After:=newBook.Sheets(newBook.Worksheets.Count)
    'newBook.Sheets(newBook.Worksheets.Count).Name = "Regional Reports"
    newBook.Sheets(newBook.Worksheets.Count).Name = shtStart.ComboBox1.Value
    TemplateBook.Sheets("Report Notes").Copy After:=newBook.Sheets(newBook.Worksheets.Count)
    newBook.Sheets(newBook.Worksheets.Count).Name = "Report Notes"
    
    
    Application.DisplayAlerts = False
    newBook.Sheets("Sheet1").Delete
    On Error Resume Next
    newBook.Sheets("Sheet2").Delete
    On Error Resume Next
    newBook.Sheets("Sheet3").Delete
    Application.DisplayAlerts = True
    

' delete all queries in new workbook
    Dim wks As Worksheet, qtb As QueryTable
    For Each wks In newBook.Worksheets
    For Each qtb In wks.QueryTables
          qtb.Delete
    Next qtb
    Next wks
    
    TemplateBook.Activate
    
End Sub