Excel VBA - 数据连接有时会明显地打开工作簿

Question

当我调用打开与另一个工作簿的连接时，该工作簿偶尔会在 Excel 中完全打开。我使用这种方法提取了大约 15 个数据集，但我无法识别模式。昨天，刷新快速无缝，Excel 中没有明显打开的工作簿。 Excel.

今天 2 个中的第 1 个开放

由于我的用户对 Excel 有不同的体验，我想消除这种可能令人困惑的行为。

oCnC.Open "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & Filename & ";Extended Properties=""Excel 12.0; HDR=YES;"";"

示例代码：

sub Caller
    Set dTabs = New Dictionary
    Set dTabs("Cerner") = New Dictionary
        dTabs("Cerner")("Query") = "Select Field1, Field2 from [Sheet1$]"
        dTabs("Cerner")("Hidden") = 1
    Call GetMasterTables("\\Files\File1.xlsx", dTabs)
    dTabs.RemoveAll

    Set dTabs = New Dictionary
    Set dTabs("SER") = New Dictionary
        dTabs("SER")("Query") = "Select [1],F75 from [Sheet1$]"
        dTabs("SER")("Hidden") = 1
    Call GetMasterTables("\Files\File2.xlsx", dTabs)
    dTabs.RemoveAll
    (Cleanup)
End Sub

Private Sub GetMasterTables(Filename As String, dTabset As Dictionary, ByRef wb As Workbook)
    Dim oCnC As Connection
    Dim rsC As Recordset
    Dim rsE As Recordset
    Dim lo As ListObject
    Dim rngHome As Range

    Set oCnC = New Connection
    Set rsC = New Recordset
    Set rsE = New Recordset
    Dim ws As Worksheet

    oCnC.Open "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & Filename & ";" & _
              "Extended Properties=""Excel 12.0; HDR=YES;"";"
    rsC.ActiveConnection = oCnC

    For Each i In dTabset
        If SheetExists(i, wb) Then
            Set ws = wb.Sheets(i)
            ws.Visible = xlSheetVisible
        Else
            Set ws = wb.Sheets.Add(, wb.Sheets(wb.Sheets.count))
            ws.Name = i
            ws.Visible = xlSheetVisible
        End If
        Set rngHome = ws.Range("A1")
        If RangeExists("Table_" & Replace(i, "-", "_"), ws) Then
            Set lo = ws.ListObjects("Table_" & Replace(i, "-", "_"))
            lo.DataBodyRange.Delete
        Else
            Set lo = ws.ListObjects.Add(, , , xlYes, rngHome)
            lo.Name = "Table_" & Replace(i, "-", "_")
            lo.DisplayName = "Table_" & Replace(i, "-", "_")

        End If
        If dTabset(i).Exists("Query") Then
            rsC.Source = dTabset(i)("Query")
        Else
            rsC.Source = "Select * from [" & i & "$]"
        End If
        rsC.Open
        rsC.MoveFirst
        ws.Range(lo.HeaderRowRange.Offset(1, 0).address).Value = "hi"
        lo.DataBodyRange.CopyFromRecordset rsC
        rsC.MoveFirst
        For Each j In lo.HeaderRowRange.Cells
            j.Value = rsC.Fields(j.Column - 1).Name
        Next j
        rsC.Close
        If dTabset(i).Exists("Hidden") Then
            ws.Visible = xlSheetHidden
        Else
            ws.Visible = xlSheetVisible
        End If
    Next i
End Sub

 Function SheetExists(ByVal shtName As String, Optional wb As Workbook) As Boolean
     Dim sht As Worksheet

     If wb Is Nothing Then Set wb = ActiveWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

 Function RangeExists(ByVal rngName As String, Optional ws As Worksheet) As Boolean
     Dim rng As ListObject

     If ws Is Nothing Then Set ws = ActiveWorksheet
     On Error Resume Next
     Set rng = ws.ListObjects(rngName)
     On Error GoTo 0
     RangeExists = Not rng Is Nothing
 End Function

更新 1

啊哈！我有一个更新。

上次测试后，我将练习簿打开。几分钟后，当我回到电脑前时，系统提示该文件可供编辑。间歇性行为可能是由于另一个用户正在打开请求的文件。我通过关闭工作簿然后重新运行 sub 来测试这个理论，但它没有在应用程序中打开文件。

更新 2 合格的我的床单参考。问题仍在发生。

Answer 1

问题出在这里（以及您在没有对象引用的情况下使用 Sheets 的任何其他地方）：

Set ws = Sheets(i)
ws.Visible = xlSheetVisible

Sheets 是 Application 的全局集合，而不是代码来自运行的工作簿。追踪所有这些不合格的引用并使它们明确：

Set ws = ThisWorkbook.Sheets(i)

您还应该在此处传递您的可选参数：

'SheetExists(i)
'...should be...
SheetExists(i, ThisWorkbook)

我猜这是间歇性的原因是您正在捕获 ADO 连接有其他工作簿处于活动状态的实例，并且您的引用没有指向它们应该指向的位置。

Answer 2

除了@Comintern 和@YowE3K 提供的代码审查之外，我还找到了以下解决方案：

验证我的工作簿和工作表
关闭屏幕更新（这样用户就看不到我的魔法了）

在我进行更新之前将书名放入字典中，并关闭在更新期间打开的所有附加内容。

Application.ScreenUpdating = False
For i = 1 To Application.Workbooks.count
Set dBooks(Application.Workbooks(i).Name) = i
Next i
Application.ScreenUpdating = False

问题代码

    For i = 1 To Application.Workbooks.count
        If dBooks.Exists(Application.Workbooks(i).Name) Then
            dBooks.Remove (Application.Workbooks(i).Name)
        Else
            dBooks(Application.Workbooks(i).Name) = i
        End If
    Next i
    For Each bookname In dBooks
        Application.Workbooks(bookname).Close (False)
    Next
    Application.ScreenUpdating = True

Excel VBA - 数据连接有时会明显地打开工作簿

Excel VBA - Data connection opens workbook visibly sometimes

oledb

excel

vba