将记录集发送到另一个宏答案

【问题标题】：Send a recordset to another macro将记录集发送到另一个宏
【发布时间】：2020-01-16 05:22:35
【问题描述】：

我有一个用于更新 Excel 插件中的 SQL 表的宏。为了从多个文件中使用相同的宏，我希望能够在连接之外创建记录集，然后将其作为参数发送到更新宏。这可能吗？

我曾尝试查看在内存记录集中找到的解决方案，但这些似乎更侧重于创建列而不是列值对。

Sub test()
Dim ws As Worksheet
Dim serverName As String
Dim dataBase As String

Dim forecastDate As Date
Dim projectNum As Long
Dim SqlStr As String

Dim rst As New ADODB.Recordset

Set ws = ActiveSheet

serverName = "Servername"
dataBase = "database"

forecastDate = ws.Cells(2, "B").Value
projectNum = ws.Cells(3, "B").Value
SqlStr = "SELECT * From forecast WHERE forecastDate='" & forecastDate & "' AND projectNum = '" & projectNum & "';"

Set rst = New ADODB.Recordset
rst!forecastDate = forecastDate
rst!projectNum = projectNum
rst!Data = Cells(4, "B").Value


Application.Run "updateMacro", serverName, dataBase, SqlStr, rst
rst.Close

End Sub


'Part of the updateMacro:

Set conn = New ADODB.Connection
cs = "DRIVER=SQL Server;DATABASE=" & dataBase & ";SERVER=" & serverName & ";Trusted_connection=yes;"
conn.Open cs

'Set rst = New ADODB.Recordset
rst.Open SqlStr, conn, adOpenDynamic, adLockOptimistic 'adLockPessimistic

If rst.EOF Then
    rst.AddNew
End If

'get the recordset from caller macro and update

rst.Update

rst.Close
Set rst = Nothing
conn.Close
Set conn = Nothing

我想在 updateMacro 之外创建记录集并在该宏中使用它，或者创建某种列-值对，可以复制到 updateMacro 中的记录集。

【问题讨论】：

标签： sql excel vba recordset

【解决方案1】：

您可以将记录集声明为全局，也可以在函数/子程序之间传递记录集。示例请参见下面的代码：

Option Explicit

'Global Recordset to be sued by other functions
Private rsMain As ADODB.Recordset

Public Function ImportData(ByVal fyYear As String) As Long

    Dim sConnString As String, sqlYears As String
    Dim conn As ADODB.Connection
    Dim tCount As Long

    sConnString = "Provider=SQLOLEDB;Data Source=server2;" & "Initial Catalog=FPSA;" & "Integrated Security=SSPI;"

    sqlYears = "select ltrim(rtrim(FinYearDesc)) as FinYearDesc, Month, AccountType, ltrim(rtrim(AccountName))as AccountName, " & _
              "ActualValue, BudgetValue from [GL_AccountMovements] where FinYearDesc >= '" & fyYear & "'"

    Set conn = New ADODB.Connection
    Set rsMain = New ADODB.Recordset

    rsMain.CursorLocation = adUseClient
    rsMain.Open sqlYears, conn, _
         ADODB.adOpenForwardOnly, _
         ADODB.adLockBatchOptimistic

    Set rsMain.ActiveConnection = Nothing

    conn.Close

    If Not rsMain.EOF Then
        tCount = rsMain.RecordCount
    End If

    ImportData = tCount

End Function
'An example of using Global Recordset
Function GetAccountsByYearMonth(ByVal strYTDLastYear as String) As Double

    Dim lastYearYTDAct As Double

    rsMain.Filter = strYTDLastYear
    Do While Not rsMain.EOF
        lastYearYTDAct = lastYearYTDAct + rsMain.Fields("ActualValue")
        rsMain.MoveNext
    Loop

    GetAccountsByYearMonth = lastYearYTDAct

End Function

谢谢

【讨论】：