VBS启动VBA时Power Query刷新失败（原正常）求助

我有一个包含多个连接公司SQL数据库的Power Query的Excel文件，其中的VBA宏此前正常运行近一年。通过VBS启动该宏时，它会自动刷新Power Query、相关数据透视表，最终生成包含文件截图的销售数据自动报表。但近几周通过VBS启动时，从以下代码行开始持续出现运行时错误1004：

Wb.Sheets("2_Pending").ListObjects("Pending_NS").QueryTable.Refresh BackgroundQuery:=False

而在VBA开发模式下重置后再次启动宏则可正常运行。请问为何该宏突然无法在VBS模式下完成刷新操作？

Sub Refresh()

    Dim PTB1 As PivotTable
    Dim RptDate As String
    Dim HTMLBody As String
    Dim Wb As Workbook
    Dim oWB As Workbook
    Dim rng As Range
    Dim Ht As String
    Dim olApp As Object
    Dim olMail As Object
    
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Application.DisplayAlerts = False
    
    Set Wb = Workbooks.Open("\x\New_Corp_New_Sales_Template.xlsm")
    
    Wb.Sheets("NS_Activation2").Select
    RptDate = Wb.Sheets("NS_Activation2").Range("p7")
    
    ' Pending
    Wb.Sheets("2_Pending").Select
    Wb.Sheets("2_Pending").ListObjects("Pending_NS").QueryTable.Refresh BackgroundQuery:=False
    Application.Wait (Now + TimeValue("00:05:00"))
    
    ' Activated
    Wb.Sheets("1_Activated").Select
    Wb.Sheets("1_Activated").ListObjects("Activated_NS").QueryTable.Refresh BackgroundQuery:=False
    Application.Wait (Now + TimeValue("00:05:00"))
    
    ' Sys Agt
    Wb.Sheets("3_Sys_Agt").Select
    Wb.Sheets("3_Sys_Agt").ListObjects("Sys_Agt").QueryTable.Refresh BackgroundQuery:=False
    Application.Wait (Now + TimeValue("00:03:00"))
    
    ' Combine
    Wb.Sheets("4 Combined").Select
    Wb.Sheets("4 Combined").ListObjects("Combine").QueryTable.Refresh BackgroundQuery:=False
    Application.Wait (Now + TimeValue("00:05:00"))
    
    ' Pv Table Refresh

    Wb.Sheets("NS_Activation2").Select
    Set PTB1 = Wb.Sheets("NS_Activation2").PivotTables("PivotTable1")
    
    With PTB1
        .ClearAllFilters
        .PivotFields("act_mth").CurrentPage = Sheets("NS_Activation2").Range("P6").Value
        .PivotFields("Exclude").CurrentPage = Sheets("NS_Activation2").Range("Q6").Value
        .RefreshTable
    End With
    
    'Send pic
    
    ' Off
    Application.CutCopyMode = False
    Set rng = Wb.Sheets("NS_Activation2").Range("A5:O102")
    ' Wait
    Application.Wait (Now + TimeValue("00:00:05"))
    ' Copy range as picture
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    ' Create Outlook email
    
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    
    HTMLBody2 = "<span LANG=EN>" _
        & "Daily NS Report by AM (click below link for excel version):" _
        & "<br><br><br><br>" _
        & "\x\" _
        & "<br><br><br><br>" _
        & "<br></font></span>"
    
    With olMail
        .To = "x"
        .CC = "x"
        .Subject = "Corp New Sales Report as of " & RptDate & "  <<Confidential - Customer>>"
        .HTMLBody = HTMLBody2
        .BodyFormat = 2 ' HTML format
        .Display
        
        ' Get Word editor
        Set wdDoc = .GetInspector.WordEditor
        Set wdRng = wdDoc.Range
        wdRng.collapse Direction:=0
        wdRng.Paste
        
        ' Increase picture size
        Set shp = wdDoc.InlineShapes(wdDoc.InlineShapes.Count)
        shp.Width = shp.Width * 1.45 ' Increase width by 45%
        shp.Height = shp.Height * 1.45 ' Increase height by 45%
        
        Application.Wait (Now + TimeValue("00:00:01"))
    
        '.Send
    End With
    
    ' Clean up
    Set olApp = Nothing
    Set olMail = Nothing
    Set wdDoc = Nothing
    Set wdRng = Nothing
    
    ' On
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Application.DisplayAlerts = False

End Sub

'Input Excel File's Full Path
  ExcelFilePath = "\x\New_Corp_New_Sales_Template.xlsm"

'Input Module/Macro name within the Excel File
  MacroPath = "Module1.Refresh"


'Create an instance of Excel
  Set ExcelApp = CreateObject("Excel.Application")

'Do you want this Excel instance to be visible?
  ExcelApp.Visible = True  'or "False"

'Prevent any App Launch Alerts (ie Update External Links)
  ExcelApp.DisplayAlerts = False

'Open Excel File
  Set wb = ExcelApp.Workbooks.Open(ExcelFilePath)

'Execute Macro Code
  ExcelApp.Run MacroPath

'Save Excel File (if applicable, no need)
  wb.Save

'Close Excel File
  wb.Close

'End instance of Excel
  ExcelApp.Quit

'Leaves an onscreen message!
  'MsgBox "Your Automated Task successfully ran at " & TimeValue(Now), vbInformation

可能原因 #

1. Power Query连接缓存异常：VBS启动的Excel实例和手动打开的环境存在差异，Power Query的连接缓存可能残留失效会话信息，触发刷新错误；手动重置VBA时会清空当前实例缓存，连接恢复正常。
2. Excel信任策略变更：近期公司可能更新了Excel信任中心设置，禁用了外部数据自动刷新，或限制了VBS启动实例访问SQL数据库的权限。
3. SQL连接参数变更：数据库端的权限、连接字符串（IP、认证方式等）发生变化，VBS启动实例无法读取最新配置，而手动打开时会触发配置更新提示。
4. 对象模型初始化差异：VBS用CreateObject创建的Excel实例，对象模型初始化状态和手动打开不同，可能在QueryTable依赖对象未完全加载时就执行刷新。

解决方案 #

1. 添加连接重置逻辑：在刷新每个QueryTable前，重置对应Power Query连接：

   ' 针对Pending_NS连接的重置示例
   Wb.Connections("Pending_NS").OLEDBConnection.Reconnect
   Wb.Sheets("2_Pending").ListObjects("Pending_NS").QueryTable.Refresh BackgroundQuery:=False
   

   对所有QueryTable对应的连接执行此操作。
2. 优化VBS启动参数：打开工作簿前添加延迟确保加载完成，同时强制更新外部链接：

   WScript.Sleep 2000 ' 延迟2秒
   Set wb = ExcelApp.Workbooks.Open(ExcelFilePath, UpdateLinks:=3) ' 3代表始终更新链接
   

3. 检查信任中心设置：打开Excel进入文件>选项>信任中心>信任中心设置>外部内容，确保允许所有位置的外部数据，且Power Query加载项未被禁用。
4. 改用Power Query原生刷新：替换原QueryTable刷新方式为连接直接刷新：

   Wb.Sheets("2_Pending").ListObjects("Pending_NS").QueryTable.WorkbookConnection.Refresh
   

5. 添加错误重试机制：在VBA中加入错误捕获和重试逻辑，处理临时连接异常：

   Dim retryCount As Integer
   retryCount = 0
   

RetryRefresh:
On Error Resume Next
Wb.Sheets("2_Pending").ListObjects("Pending_NS").QueryTable.Refresh BackgroundQuery:=False
If Err.Number = 1004 And retryCount < 2 Then
retryCount = retryCount + 1
Application.Wait (Now + TimeValue("00:00:10"))
Err.Clear
GoTo RetryRefresh
End If
On Error GoTo 0

> 内容的提问来源于stack exchange，提问作者Ed K