刷新时出现Excel数据连接错误

时间:2014-04-23 15:08:47

标签: excel vba ms-access excel-vba excel-2010

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

我在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克服其自我限制。如果有人比较熟悉,我很想听到更多的信息!

4 个答案:

答案 0 :(得分:3)

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

这是我在收到此错误时在VBA中所做的事情,尽管我会说我没有在MS访问数据库中使用它。我有一个excel工作簿,我用作&#39;跑步者&#39;它逐一打开了其他书籍并刷新了他们的联系。基本上我有pathextension的变量,并将每个工作簿的名称放入一个数组中并循环遍历数组。

我将路径和扩展名组合在一起,为我提供了文件的完整文件名,您将在循环中看到它。

这就是我的循环:

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 Report"

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

让我知道这是否有效。

答案 1 :(得分:2)

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

我相信您可以通过调试Connections来解决此问题。尝试使用以下Sub替换上面的刷新代码(以及使用DoEvents替换)。首先,可以在Refreshes之间显示对话框来解决问题(如果问题是并发刷新等)。其次,每次运行时,请仔细检查没有任何变化。请回复任何发现或信息。如果仍然出现错误,请逐步执行代码并报告引发错误的行。

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

如果您仍然遇到错误,可以回答其他问题:

  • BackgroundQuery总是假的吗?
  • 每组对话框之间是否存在可察觉的延迟(表示Excel正在等待刷新完成)或者它们是否在最后一个之后立即出现?
  • 哪行代码会引发初始错误?如果以向后顺序刷新Connections(通过取消注释&#34;步骤-1和#34;行),您是否在同一连接上得到错误?
  • 当您说您可以手动更新连接时,是通过不同的宏还是通过数据&gt;&gt;连接&gt;&gt;刷新?
  • 如果您手动选择&#34; RefreshAll&#34;?
  • ,则会出现任何错误

很抱歉所有问题,但在调试这样令人讨厌的连接错误时你必须考虑所有问题。

答案 2 :(得分:0)

您可以使用VBA通过activeworkbook。connections对象单独调用刷新。有关此方法的一些线索,请参阅this Stack Overflow post。更原子化的方法可以让更好的洞察和控制。例如,完成所有步骤后,您可以尝试将问题DoEvents插入solve

答案 3 :(得分:0)

要清除系统内存,您始终可以运行以下内容:

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

这将清除撤消堆栈,其中包含您的数据透视表的所有更新,允许您撤消它们,如果您在中间参数中执行此操作,它可以帮助您控制内存使用。

请不要理会我以前的建议,因为我正在考虑一个帮助我进入Access的解决方案。