VBA 多个 SQL 查询到 Excel

Question

我需要一些帮助。

我有以下工作 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

我修改成下面的，但我觉得这不是最有效的方法。我正在考虑创建一个循环。请帮助：

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