Vba 刷新时Excel数据连接错误

解决了！请参阅下面的解决方案

我在Excel 2010中通过数据透视表连接到多个独立的Access 2010 db

刷新所有连接会导致最终刷新失败。顺序不重要，我手动刷新了不同的顺序，相同的错误

但是，如果我在刷新了一些之后保存并关闭，然后返回并刷新最后一个，则根本没有问题

这让我相信，当我保存并关闭时，我碰到了某种内存上限，它会被重置

我是否可以通过VBA重新创建该效果而不实际保存/关闭？是否有更好的解决方案

错误消息-这三条消息按以下顺序弹出：

• 查询未运行，或无法打开数据库表
• 获取数据的问题
• 使用连接的数据透视表、多维数据集函数或切片器刷新失败

当前代码

Private Sub CommandButton1_Click()
On Error GoTo ErrHndlr

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = "Refreshing Data - Please Be Patient"

ActiveWorkbook.Connections("Connection_1").Refresh
ActiveWorkbook.Connections("Connection_2").Refresh
ActiveWorkbook.Connections("Connection_3").Refresh

Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "Ready"
[LastUpdated].Value = FormatDateTime(Now, vbGeneralDate)
Application.ScreenUpdating = True
Exit Sub

ErrHndlr:
  Application.StatusBar = "Ready"
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  [LastUpdated].Value = "Update Error"
  Exit Sub

End Sub

连接字符串

Provider=Microsoft.ACE.OLEDB.12.0
;User ID=Admin
;Data Source=C:\Folders\Database_1.accdb
;Mode=Share Deny None
;Extended Properties=""
;Jet OLEDB:System database=""
;Jet OLEDB:Registry Path=""
;Jet OLEDB:Engine Type=6
;Jet OLEDB:Database Locking Mode=0
;Jet OLEDB:Global Partial Bulk Ops=2
;Jet OLEDB:Global Bulk Transactions=1
;Jet OLEDB:New Database Password=""
;Jet OLEDB:Create System Database=False
;Jet OLEDB:Encrypt Database=False
;Jet OLEDB:Don't Copy Locale on Compact=False
;Jet OLEDB:Compact Without Replica Repair=False
;Jet OLEDB:SFP=False
;Jet OLEDB:Support Complex Data=False
;Jet OLEDB:Bypass UserInfo Validation=False

---

尝试的解决方案

• 禁用后台刷新-已禁用
• 禁用自动恢复（以节省内存）
• 清除“撤消堆栈”（以节省内存）
• “DoEvents”延迟代码执行，直到每次刷新结束，更改：

这个

到

解决方案

旁注，我有几个额外的连接，我不想通过这段代码更新，并添加了一些额外的、简单的逻辑来指定我想要更新的连接。此代码用于刷新工作簿中的每个连接：

Dim i As Integer
Dim awc As WorkbookConnection
Dim c As OLEDBConnection

Set awc = ActiveWorkbook.Connections.Item(i)
Set c = awc.OLEDBConnection
c.EnableRefresh = True
c.BackgroundQuery = False
c.Reconnect
c.Refresh
awc.Refresh
c.MaintainConnection = False
Next i

---

我不知道为什么会这样，这其中的哪一部分可以让Excel克服它的自我限制。如果有人更熟悉的话，我希望听到更多

因此，当我试图创建一个VBA脚本以在给定时间自动刷新excel工作簿时，我遇到了一个类似的错误，我在VBA脚本中做了一些事情来实现这一点。其中一个正在禁用后台刷新。这可能是您的问题，您可以通过转到连接属性并禁用后台刷新来轻松禁用它

下面是我在VBA中遇到此错误时所做的操作，不过我要说的是，我没有将其与MS access db一起使用。我有一本excel工作簿，我用它作为“跑步者”，它一本接一本地打开了其他书籍，刷新了它们之间的连接。基本上，我为

路径

和

扩展名

设置了一个变量，将每个工作簿的名称放入一个数组中，并在数组中循环

我结合了路径和扩展名，给出了文件的完整文件名，您将在循环中看到

这就是我的循环的样子：

For i = LBound(testArray) To UBound(testArray)
    Dim wb As Workbook
    Set wb = Workbooks.Open(path & testArray(i) & ext, 0, False)

    'Next I checked to see if the workbook was in protected view and allowed for editing.
    If Application.ProtectedViewWindows.Count > 0 Then
        Application.ActiveProtectedViewWindow.Edit
    End If

    'Now comes the part that I believe should help for your case
    wb.Connections(testArray(i) & "This is your connection name").OLEDBConnection.BackgroundQuery = False
    wb.RefreshAll
    wb.Connections(testArray(i) & "This is your connection name").OLEDBConnection.BackgroundQuery = True

    wb.SaveAs fileName:= "Thisbook.xlsx"
    wb.Close
Next i

要获取连接名，有几种方法，包括手动查看连接名。对我来说，因为我想这样做，所以我不需要手动输入每个连接名，我使用了我在连接名中看到的固有模式

在我的例子中，这是工作手册和“POS报告”的基本名称

我相信您可能会因为背景刷新而出现错误。因此，如果您不需要在VBA中执行此操作，我建议您转到连接属性并禁用它

---

让我知道这是否有效。

您可以使用VBA通过.connections对象单独调用刷新。有关此方法的一些线索，请参阅。更原子化的方法可能允许更好的洞察和控制。例如，在完成所有步骤后，您可以尝试向问题插入

DoEvents

。

要清除系统内存，您可以始终运行以下操作：

Sub ClearUndo()
Range("A1").Copy Range("A1")
End Sub

这将清除包含对透视表的所有更新的撤消堆栈，允许您撤消这些更新，如果您在引用之间执行此操作，则可能有助于控制内存使用

---

请不要考虑我之前的建议，因为我正在考虑一个帮助我访问的解决方案。

这不是一个完整的答案，而是一个帮助调试的尝试，希望我们能够找到一个解决方案

我相信您可以通过调试连接来解决此问题。尝试用以下子项替换上面的刷新代码（以及用DoEvents替换的代码）。首先，显示刷新之间的对话框可能会解决问题（如果问题是并发刷新等）。其次，每次运行时，都要仔细检查，确保没有任何变化。请报告任何发现或信息。如果仍然出现错误，请逐步检查代码并报告引发错误的行

Sub ShowDebugDialog()

   Dim x As Integer
   Dim i As Integer, j As Integer
   Dim awc As WorkbookConnection
   Dim c As OLEDBConnection

   For i = 1 To ActiveWorkbook.Connections.Count
   'For i = ActiveWorkbook.Connections.Count To 1 Step -1

      For j = 1 To ActiveWorkbook.Connections.Count
         Set awc = ActiveWorkbook.Connections.Item(j)
         Set c = awc.OLEDBConnection
         x = MsgBox("ConnectionName: " & awc.Name & vbCrLf & _
              "IsConnected: " & c.IsConnected & vbCrLf & _
              "BackgroundQuery: " & c.BackgroundQuery & vbCrLf & _
              "MaintainConnection: " & c.MaintainConnection & vbCrLf & _
              "RobustConnect: " & c.RobustConnect & vbCrLf & _
              "RefreshPeriod: " & c.RefreshPeriod & vbCrLf & _
              "Refreshing: " & c.Refreshing & vbCrLf & _
              "EnableRefresh: " & c.EnableRefresh & vbCrLf & _
              "Application: " & c.Application & vbCrLf & _
              "UseLocalConnection: " & c.UseLocalConnection _
              , vbOKOnly, "Debugging")
      Next j

      Set awc = ActiveWorkbook.Connections.Item(i)
      Set c = awc.OLEDBConnection
      c.EnableRefresh = True
      c.BackgroundQuery = False
      c.Reconnect
      c.Refresh
      awc.Refresh
      c.MaintainConnection = False
   Next i

End Sub

如果仍有错误，您可以回答其他问题：

• 背景查询总是错误的吗
• 每套对话框之间是否存在明显的延迟（表示Excel正在等待刷新完成），或者它们是否都在最后一个对话框之后立即出现
• 哪一行代码引发初始错误？如果您按向后顺序刷新连接（通过取消对“Step-1”行的注释），是否会在同一个连接上出现错误
• 当您说可以手动更新连接时，是通过其他宏还是通过数据>>连接>>刷新
• 如果手动选择“刷新全部”，是否有任何错误

---

很抱歉提出这些问题，但在调试像这样严重的连接错误时，您必须考虑所有问题。

我也有过类似的经验，得到了类似的结果：启用后台刷新可以让所有数据透视表查询和重建同时运行。由于它们可能单独需要大量内存，总体上可能已经用完了。@RBarryYoung VBA代码的美妙之处在于，我在最后恢复了背景刷新，所以它实际上不会改变工作簿中的任何内容，只需刷新

Sub ClearUndo()
Range("A1").Copy Range("A1")
End Sub

Sub ShowDebugDialog()

   Dim x As Integer
   Dim i As Integer, j As Integer
   Dim awc As WorkbookConnection
   Dim c As OLEDBConnection

   For i = 1 To ActiveWorkbook.Connections.Count
   'For i = ActiveWorkbook.Connections.Count To 1 Step -1

      For j = 1 To ActiveWorkbook.Connections.Count
         Set awc = ActiveWorkbook.Connections.Item(j)
         Set c = awc.OLEDBConnection
         x = MsgBox("ConnectionName: " & awc.Name & vbCrLf & _
              "IsConnected: " & c.IsConnected & vbCrLf & _
              "BackgroundQuery: " & c.BackgroundQuery & vbCrLf & _
              "MaintainConnection: " & c.MaintainConnection & vbCrLf & _
              "RobustConnect: " & c.RobustConnect & vbCrLf & _
              "RefreshPeriod: " & c.RefreshPeriod & vbCrLf & _
              "Refreshing: " & c.Refreshing & vbCrLf & _
              "EnableRefresh: " & c.EnableRefresh & vbCrLf & _
              "Application: " & c.Application & vbCrLf & _
              "UseLocalConnection: " & c.UseLocalConnection _
              , vbOKOnly, "Debugging")
      Next j

      Set awc = ActiveWorkbook.Connections.Item(i)
      Set c = awc.OLEDBConnection
      c.EnableRefresh = True
      c.BackgroundQuery = False
      c.Reconnect
      c.Refresh
      awc.Refresh
      c.MaintainConnection = False
   Next i

End Sub