如何修改Excel VBA代码批量执行SQL查询并导出至不同工作表？

核心结论 #

需要在外层编写循环来遍历「SQL」工作表中的所有查询，同时建议复用同一个数据库连接以避免重复连接的性能损耗，最终实现批量替换参数、执行查询并导出到指定工作表的需求。

前提假设 #

假设你的「SQL」工作表结构如下：

• A列：目标工作表名称（例如EXPOSURE）
• B列：带占位符的SQL查询语句（例如SELECT * FROM tbl_exposure WHERE COB_DATE = '{COB_DATE}'）
• 第一行为表头，实际查询数据从第二行开始

修改后的完整VBA代码 #

Sub Batch_Execute_SQL_Queries()
    ' 初始化变量
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim ConnectionString As String
    Dim sqlSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim strQuery As String
    Dim cobDate As String
    Dim lastRow As Long
    Dim i As Long
    
    ' 设置COB_DATE参数（可改为从单元格读取，比如cobDate = Range("C1").Value）
    cobDate = "2024-06-30" ' 替换为实际需要的日期
    
    ' 绑定存储SQL查询的工作表
    Set sqlSheet = ThisWorkbook.Worksheets("SQL")
    
    ' 数据库连接字符串（修改为你的实际配置）
    ConnectionString = "Provider=SQLOLEDB.1;Password=PASSWORD;Persist Security Info=True;" & _
                       "User ID=USERNAME;Data Source=REMOTE_IP_ADDRESS;Initial Catalog=DATABASE"
    
    On Error GoTo Cleanup ' 错误处理，确保资源能正常释放
    
    ' 打开数据库连接（仅打开一次，循环复用）
    cnn.Open ConnectionString
    cnn.CommandTimeout = 900 ' 设置15分钟超时
    
    ' 获取「SQL」工作表中最后一行数据
    lastRow = sqlSheet.Cells(sqlSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 循环遍历每个查询（从第二行开始，跳过表头）
    For i = 2 To lastRow
        ' 跳过空行
        If sqlSheet.Cells(i, "A").Value = "" Or sqlSheet.Cells(i, "B").Value = "" Then
            GoTo NextQuery
        End If
        
        ' 获取目标工作表，不存在则新建
        On Error Resume Next
        Set targetSheet = ThisWorkbook.Worksheets(sqlSheet.Cells(i, "A").Value)
        On Error GoTo Cleanup
        
        If targetSheet Is Nothing Then
            Set targetSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            targetSheet.Name = sqlSheet.Cells(i, "A").Value
        End If
        
        ' 替换查询中的COB_DATE占位符
        strQuery = Replace(sqlSheet.Cells(i, "B").Value, "{COB_DATE}", cobDate)
        
        ' 执行查询
        rst.Open strQuery, cnn
        
        ' 清空目标工作表旧数据
        targetSheet.Cells.Clear
        
        ' 导出查询表头
        Dim col As Integer
        For col = 0 To rst.Fields.Count - 1
            targetSheet.Cells(1, col + 1).Value = rst.Fields(col).Name
            targetSheet.Cells(1, col + 1).Font.Bold = True ' 表头加粗
        Next col
        
        ' 导出查询结果（从A2开始）
        If Not rst.EOF Then
            targetSheet.Range("A2").CopyFromRecordset rst
        End If
        
        ' 自动调整列宽
        targetSheet.Columns.AutoFit
        
        ' 关闭当前记录集，准备下一个查询
        rst.Close
        Set targetSheet = Nothing
        
NextQuery:
    Next i
    
    MsgBox "所有查询执行完成！", vbInformation
    
Cleanup:
    ' 关闭记录集和连接，释放资源
    If Not rst Is Nothing And rst.State = adStateOpen Then
        rst.Close
    End If
    If Not cnn Is Nothing And cnn.State = adStateOpen Then
        cnn.Close
    End If
    Set rst = Nothing
    Set cnn = Nothing
    Set sqlSheet = Nothing
    
    ' 错误提示
    If Err.Number <> 0 Then
        MsgBox "执行出错：" & Err.Description, vbCritical
    End If
End Sub

关键修改说明 #

1. 循环遍历：通过For i = 2 To lastRow循环处理「SQL」工作表中的每一条查询
2. 参数替换：用Replace函数将查询中的占位符{COB_DATE}替换为实际日期
3. 工作表管理：自动检查目标工作表是否存在，不存在则新建
4. 完整数据导出：新增表头导出和自动列宽调整，解决原代码只导出数据无表头的问题
5. 错误处理：添加错误捕获机制，确保数据库连接和记录集能正常关闭，避免资源泄漏
6. 连接复用：仅建立一次数据库连接，循环中复用，大幅提升执行效率

注意事项 #

• 修改连接字符串中的PASSWORD、USERNAME、REMOTE_IP_ADDRESS、DATABASE为你的实际数据库信息
• 「SQL」工作表中的查询需使用统一占位符（如{COB_DATE}），确保参数替换生效
• 可将cobDate的赋值改为从指定单元格读取（例如cobDate = ThisWorkbook.Worksheets("参数").Range("A1").Value），方便用户修改日期参数

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