Access VBA能否将ADODB.Recordset作为SQL Server自定义表类型参数传递？

问题背景 #

在C#中可直接将DataTable作为SQL Server自定义表类型（TVP）参数传递，但在MS Access VBA里无法直接用ADODB.Recordset做相同操作。你现有代码在传递Recordset时触发错误：参数对象定义不正确。提供了不一致或不完整的信息。

原错误代码：

If ServerConOpen = False Then
    DoCmd.CancelEvent
    Exit Sub
End If
Dim cmd    As New adodb.Command
Dim rs     As New adodb.Recordset
rs.Open "CustData", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
cmd.ActiveConnection = cnx
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "CustDtaInsert"
cmd.Parameters.Append cmd.CreateParameter("@UserDefineTable", adUserDefined, adParamInput, , rs)
cmd.Execute
ServerConClose

错误触发行：

cmd.Parameters.Append cmd.CreateParameter("@UserDefineTable", adUserDefined, adParamInput, , rs)

核心原因 #

VBA的ADODB组件与SQL Server的自定义表类型之间没有原生的类型映射支持，无法直接将Recordset作为TVP参数传递，必须通过中间格式转换实现批量数据传递。

可行解决方案：XML中转法 #

将Recordset转换为XML字符串，传递给SQL Server存储过程，再在存储过程中解析XML并插入数据。

1. 修改VBA代码

If ServerConOpen = False Then
    DoCmd.CancelEvent
    Exit Sub
End If

Dim cmd As New adodb.Command
Dim rs As New adodb.Recordset
Dim xmlFilePath As String
Dim xmlData As String

' 打开本地数据集
rs.Open "CustData", CurrentProject.Connection, adOpenStatic, adLockReadOnly
xmlFilePath = Environ("TEMP") & "\CustDataTemp.xml"

' 将Recordset保存为XML文件
rs.Save xmlFilePath, adPersistXML
rs.Close
Set rs = Nothing

' 读取XML内容为字符串
Open xmlFilePath For Input As #1
xmlData = Input$(LOF(1), 1)
Close #1
Kill xmlFilePath ' 删除临时文件

' 调用存储过程传递XML参数
cmd.ActiveConnection = cnx
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "CustDtaInsert"
' 传递XML字符串，-1表示使用最大长度
cmd.Parameters.Append cmd.CreateParameter("@XmlData", adVarChar, adParamInput, -1, xmlData)
cmd.Execute

ServerConClose
Set cmd = Nothing

2. 对应SQL Server存储过程

假设目标表为Customer，字段为CustID(INT)、CustName(VARCHAR(100))、CustEmail(VARCHAR(100))，存储过程需解析XML并插入：

CREATE PROCEDURE CustDtaInsert
    @XmlData NVARCHAR(MAX)
AS
BEGIN
    SET NOCOUNT ON;

    DECLARE @XmlDoc XML
    SET @XmlDoc = CAST(@XmlData AS XML)

    -- 处理ADODB生成XML自带的命名空间
    WITH XMLNAMESPACES (
        DEFAULT 'urn:schemas-microsoft-com:xml-data',
        'urn:schemas-microsoft-com:xml-data' AS rs,
        'urn:schemas-microsoft-com:rowset' AS z
    )
    INSERT INTO Customer (CustID, CustName, CustEmail)
    SELECT
        T.row.value('@CustID', 'INT'),
        T.row.value('@CustName', 'VARCHAR(100)'),
        T.row.value('@CustEmail', 'VARCHAR(100)')
    FROM @XmlDoc.nodes('/xml/rs:data/z:row') AS T(row)
END

其他备选方案 #

• 批量插入语句：如果数据量较小，可循环Recordset生成INSERT INTO ... VALUES (...)批量语句执行，但性能不如XML方法。
• OPENROWSET读取CSV：通过VBA将数据写入本地CSV，再用SQL Server的OPENROWSET读取CSV插入，但需要配置服务器权限。

内容的提问来源于stack exchange，提问作者A.J