vba - 刷新时 Excel 数据连接错误

Question

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

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

刷新我的所有连接会导致最终刷新失败。顺序无关紧要，我已经按照不同的顺序手动刷新了，同样的错误。

但是，如果我刷新几个之后保存并关闭，然后再回来刷新最后一个，就完全没有问题了。

让我相信我遇到了某种内存上限，当我保存并关闭时，该上限会被重置。

我可以通过 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”延迟代码执行，直到每次刷新结束，更改:

这个

ActiveWorkbook.Connections("Connection_1").Refresh

至

With ActiveWorkbook.Connections("Connection_1")
  Select Case .Type
    Case xlConnectionTypeODBC
      With .ODBCConnection
        .Refresh
        Do While .Refreshing
          DoEvents
        Loop
      End With
    Case xlConnectionTypeOLEDB
      With .OLEDBConnection
        .Refresh
        Do While .Refreshing
          DoEvents
        Loop
      End With
    Case Else
      .Refresh
  End Select
End With

解决方案!

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

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 克服其 self 限制。如果有人更熟悉的话，我很想听到更多!

Answer 1

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

这是当我收到此错误时我在 VBA 中所做的操作，尽管我会说我没有将它与 MS Access 数据库一起使用。我有一本 Excel 工作簿，我将其用作“运行者”，它一一打开了其他书籍并刷新了它们的连接。基本上，我有一个用于路径和扩展名的变量，并将每个工作簿的名称放入一个数组中并循环 Access 该数组。

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

这就是我的循环的样子:

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

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

就我而言，这是baseNameOfWorkbook 和“POS 报告”

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

请告诉我这是否有效。