Excel VBA生成查询时弹出OLE DB初始化信息窗口报错求助

问题根源 #

1. 代码尝试通过OLEDB连接已打开的目标工作簿，ACE OLEDB驱动在处理处于独占打开状态的Excel文件时，会触发权限验证弹窗——因为文件被Excel锁定，无法正常读取。
2. 直接使用ListObjects.Add结合xlSrcQuery的默认配置未禁用连接交互提示，导致弹出初始化信息窗口。

修复代码 #

改用ADODB连接+记录集的方式实现查询，彻底避免OLEDB交互弹窗，同时提升稳定性：

Sub GenerateQuery()
    Dim targetMonth As String
    targetMonth = InputBox("Enter the target month (e.g., January):")
    
    Select Case LCase(targetMonth)
        Case "january", "february", "march", "april", "may", "june", _
             "july", "august", "september", "october", "november", "december"
        Case Else
            MsgBox "Please enter a valid month name."
            Exit Sub
    End Select
    
    Dim targetYear As String
    targetYear = InputBox("Enter the target year (e.g., 2023):")
    
    If Not IsNumeric(targetYear) Or Len(targetYear) <> 4 Then
        MsgBox "Invalid year format. Please enter a four-digit year.", vbExclamation
        Exit Sub
    End If

    Dim columnList As String
    columnList = "[Invoice Id], [Invoice Date], FORMAT([Invoice Date], ""mmm-dd"") AS [Formatted Date], " & _
                 "[Serial], [Purch Id], [Item Id], [Sell Price], [Revenue Share], [Vendor]"

    Dim query As String
    query = "SELECT " & columnList & " FROM [tbl_Cons_Rpt$] " & _
            "WHERE MONTH([Invoice Date]) = " & Month(DateValue(targetMonth & " 1")) & _
            " AND YEAR([Invoice Date]) = " & targetYear & _
            " AND [Vendor] = 'V005501 - Atlantic Broadband ARP'"

    Dim targetWorkbook As Workbook
    Set targetWorkbook = Workbooks.Open("C:\Users\notgonnashow.xlsx")
    targetWorkbook.Sheets("qry_ABB1").UsedRange.ClearContents

    ' 初始化ADODB连接和记录集
    Dim conn As Object
    Dim rs As Object
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    ' 连接字符串：禁用安全提示，设置只读模式避免文件锁定
    Dim connStr As String
    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & targetWorkbook.FullName & ";" & _
              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";" & _
              "Persist Security Info=False;" & _
              "Mode=Read"

    On Error GoTo Cleanup ' 错误处理
    conn.Open connStr
    rs.Open query, conn

    ' 将记录集写入目标工作表
    If Not rs.EOF Then
        targetWorkbook.Sheets("qry_ABB1").Range("A2").CopyFromRecordset rs
        ' 写入表头
        Dim i As Integer
        For i = 0 To rs.Fields.Count - 1
            targetWorkbook.Sheets("qry_ABB1").Cells(1, i + 1).Value = rs.Fields(i).Name
        Next i
    Else
        MsgBox "No data found for the specified month and year."
    End If

Cleanup:
    ' 释放资源
    If Not rs Is Nothing Then rs.Close
    If Not conn Is Nothing Then conn.Close
    Set rs = Nothing
    Set conn = Nothing

    targetWorkbook.Close SaveChanges:=True
End Sub

关键改动说明 #

• 连接字符串优化：添加Persist Security Info=False禁用安全提示弹窗，Mode=Read设置只读模式，避免与Excel的文件锁定冲突。
• SQL表名修正：Excel中查询工作表需要在表名后加$（即[tbl_Cons_Rpt$]），原代码遗漏会导致查询失败。
• ADODB替代QueryTable：用ADODB.Recordset执行查询并写入数据，完全绕过OLEDB的交互验证窗口，逻辑更灵活可控。
• 错误处理与资源释放：添加错误捕获和资源清理，提升代码健壮性。

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