Excel VBA读取数组值多次执行SQL查询并追加结果的问题

Got it，我帮你调整了代码，实现批量读取A列的CountryID并追加查询结果的需求，同时优化了代码的效率和安全性，下面是完整实现：

完整代码 #

Sub ADOExcelSQLServer_BatchQuery()
    Dim Cn As ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String
    Dim rs As ADODB.Recordset
    Dim countryIDs As Variant
    Dim i As Long, j As Long
    Dim lastRow As Long
    Dim ws As Worksheet
    
    ' 指定存放查询结果的工作表（可根据实际修改）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' --- 1. 读取A列的CountryID数据到数组 ---
    ' 找到A列最后一个非空行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 若A列仅表头或无数据，直接退出
    If lastRow < 2 Then
        MsgBox "A列未检测到可用于查询的CountryID数据！", vbExclamation
        Exit Sub
    End If
    ' 读取A2至最后一行的数据到数组
    countryIDs = ws.Range("A2:A" & lastRow).Value
    ' 将Excel返回的二维单列数组转为一维，方便遍历
    If IsArray(countryIDs) Then
        countryIDs = Application.Transpose(countryIDs)
    End If
    
    ' --- 2. 初始化ADO数据库连接 ---
    Server_Name = "EXCEL-PC\EXCELDEVELOPER" ' 替换为你的SQL Server实例名
    Database_Name = "AdventureWorksLT2012" ' 替换为你的数据库名
    User_ID = "" ' 替换为你的数据库用户名
    Password = "" ' 替换为你的数据库密码
    
    Set Cn = New ADODB.Connection
    On Error GoTo Cleanup ' 错误捕获，确保资源能正确释放
    
    ' 打开连接（这里用ODBC驱动，也可改用OLEDB驱动：Provider=SQLOLEDB）
    Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
            ";Uid=" & User_ID & ";Pwd=" & Password & ";"
    
    ' --- 3. 准备参数化SQL语句（避免SQL注入，提升安全性） ---
    SQLStr = "SELECT * FROM [SalesLT].[Customer] WHERE CountryID = ?"
    
    ' --- 4. 遍历数组中的每个ID执行查询并追加结果 ---
    Set rs = New ADODB.Recordset
    For i = LBound(countryIDs) To UBound(countryIDs)
        ' 跳过空值
        If countryIDs(i) <> "" Then
            ' 执行参数化查询
            rs.Open SQLStr, Cn, adOpenStatic, adLockReadOnly, adCmdText
            ' 为参数赋值（参数索引从0开始）
            rs.ActiveCommand.Parameters(0).Value = countryIDs(i)
            
            ' 找到当前结果区域的最后一行，用于追加数据
            lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
            ' 首次查询时先写入表头
            If lastRow = 1 Then
                ' 写入字段名作为表头
                For j = 0 To rs.Fields.Count - 1
                    ws.Cells(1, j + 2).Value = rs.Fields(j).Name
                Next j
                lastRow = 2 ' 下一行开始写入数据
            Else
                lastRow = lastRow + 1 ' 跳到下一行追加新数据
            End If
            
            ' 将查询结果写入工作表（如果有数据的话）
            If Not rs.EOF Then
                ws.Range(ws.Cells(lastRow, 2), ws.Cells(lastRow + rs.RecordCount - 1, rs.Fields.Count + 1)).CopyFromRecordset rs
            End If
            
            rs.Close ' 关闭当前记录集，准备下一次查询
        End If
    Next i
    
    MsgBox "批量查询已完成！", vbInformation

Cleanup:
    ' 强制清理资源，避免连接泄漏
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
    End If
    If Not Cn Is Nothing Then
        If Cn.State = adStateOpen Then Cn.Close
        Set Cn = Nothing
    End If
    Set ws = Nothing
    
    ' 若有错误，弹出错误信息
    If Err.Number <> 0 Then
        MsgBox "执行出错：" & Err.Description, vbCritical
    End If
End Sub

关键优化点说明 #

• 高效读取A列数据：通过End(xlUp)找到A列最后非空行，读取区域后转为一维数组，避免逐行读取的低效操作；同时增加了空数据判断，防止无意义执行。
• 复用数据库连接：仅在循环前打开一次连接，循环结束后关闭，相比每次查询都打开/关闭连接，能大幅提升批量查询的效率。
• 参数化查询：使用?作为参数占位符，代替直接拼接SQL字符串，既避免了SQL注入风险，也能防止因特殊字符导致的SQL语法错误。
• 智能追加结果：每次查询前自动定位结果区域的最后一行，首次查询时写入表头，后续查询直接追加数据，不会覆盖原有内容。
• 完善的错误处理：通过On Error GoTo Cleanup确保即使中途出错，数据库连接和记录集也能被正确关闭，避免资源泄漏。

使用注意事项 #

1. 确保VBA编辑器中已引用Microsoft ActiveX Data Objects x.x Library（路径：工具 -> 引用，勾选对应版本）。
2. 根据你的实际环境修改代码中的服务器名、数据库名、用户名和密码。
3. 代码默认将查询结果写入B列开始的区域，若需要调整写入位置，修改ws.Cells(lastRow, 2)中的列号即可。

内容的提问来源于stack exchange，提问作者ben800