VBA多个SQL查询到Excel

我需要一些帮助。

我有以下工作的VBA将数据导入到Excel的存储过程。

挑战是如何修改代码以运行多个存储过程并将其粘贴到不同的页面上。

请帮忙。

Sub Macro1() ' Create a connection object. Dim cnPubs As ADODB.Connection Set cnPubs = New ADODB.Connection ' Provide the connection string. Dim strConn As String 'Use the SQL Server OLE DB Provider. strConn = "PROVIDER=SQLOLEDB;" 'Connect to the Pubs database on the local server. strConn = strConn & "DATA SOURCE=PC\SQL2014;INITIAL CATALOG=Option Database;" 'Use an integrated login. strConn = strConn & " INTEGRATED SECURITY=sspi;" 'Now open the connection. cnPubs.Open strConn ' Create a recordset object. Dim rsPubs As ADODB.Recordset Set rsPubs = New ADODB.Recordset With rsPubs ' Assign the Connection object. .ActiveConnection = cnPubs ' Extract the required records. .Open "EXEC sp_Week_Option1_01_Export" ' Copy the records into cell A1 on Sheet1. Sheet4.Range("A2").CopyFromRecordset rsPubs For intColIndex = 0 To rsPubs.Fields.Count - 1 Range("A1").Offset(0, intColIndex).Value = rsPubs.Fields(intColIndex).Name Next ' Tidy up .Close End With cnPubs.Close Set rsPubs = Nothing Set cnPubs = Nothing ' End Sub 

我修改为以下，但我觉得这不是最有效的方法。 我在想创build一个循环。 请帮忙：

 Sub Macro1() ' Create a connection object. Dim cnPubs As ADODB.Connection Set cnPubs = New ADODB.Connection ' Provide the connection string. Dim strConn As String 'Use the SQL Server OLE DB Provider. strConn = "PROVIDER=SQLOLEDB;" 'Connect to the Pubs database on the local server. strConn = strConn & "DATA SOURCE=PC\SQL2014;INITIAL CATALOG=Option Database;" 'Use an integrated login. strConn = strConn & " INTEGRATED SECURITY=sspi;" 'Now open the connection. cnPubs.Open strConn ' Create a recordset object. Dim rsPubs As ADODB.Recordset Dim rsPubs2 As ADODB.Recordset Set rsPubs = New ADODB.Recordset Set rsPubs2 = New ADODB.Recordset With rsPubs ' Assign the Connection object. .ActiveConnection = cnPubs ' Extract the required records. .Open "EXEC sp_Week_Option1_01_Export" ' Copy the records into cell A1 on Sheet1. Sheet4.Range("A2").CopyFromRecordset rsPubs For intColIndex = 0 To rsPubs.Fields.Count - 1 Sheet4.Range("A1").Offset(0, intColIndex).Value = rsPubs.Fields(intColIndex).Name Next ' Tidy up .Close End With With rsPubs2 ' Assign the Connection object. .ActiveConnection = cnPubs ' Extract the required records. .Open "sp_Week_Option1_01_Export_Crosstab" ' Copy the records into cell A1 on Sheet1. Sheet9.Range("A2").CopyFromRecordset rsPubs2 For intColIndex = 0 To rsPubs2.Fields.Count - 1 Sheet9.Range("A1").Offset(0, intColIndex).Value = rsPubs2.Fields(intColIndex).Name Next ' Tidy up .Close End With cnPubs.Close Set rsPubs = Nothing Set cnPubs = Nothing ' End Sub 

Answer 1

这听起来应该是它自己的子程序。 您可以通过传递过程来执行，然后在工作表中放置结果，随时调用Sub。

 Public Sub Macro1(byval storedProc as string, byval ws as worksheet) ' Create a connection object. Dim cnPubs As ADODB.Connection Set cnPubs = New ADODB.Connection ' Provide the connection string. Dim strConn As String 'Use the SQL Server OLE DB Provider. strConn = "PROVIDER=SQLOLEDB;" 'Connect to the Pubs database on the local server. strConn = strConn & "DATA SOURCE=PC\SQL2014;INITIAL CATALOG=Option Database;" 'Use an integrated login. strConn = strConn & " INTEGRATED SECURITY=sspi;" 'Now open the connection. cnPubs.Open strConn ' Create a recordset object. Dim rsPubs As ADODB.Recordset Set rsPubs = New ADODB.Recordset With rsPubs ' Assign the Connection object. .ActiveConnection = cnPubs ' Extract the required records. .Open storedProc ' Copy the records into cell A1 on Sheet1. ws.Range("A2").CopyFromRecordset rsPubs For intColIndex = 0 To rsPubs.Fields.Count - 1 ws.Range("A1").Offset(0, intColIndex).Value = rsPubs.Fields(intColIndex).Name Next ' Tidy up .Close End With cnPubs.Close Set rsPubs = Nothing Set cnPubs = Nothing ' End Sub