Question

当我打电话打开与另一个工作簿的连接时，有时工作簿将在Excel中完全打开。我使用这种方法得到了大约15个数据集，但我无法识别模式。昨天刷新快速无缝，没有工作簿在Excel中可见。今天1中的2个在Excel中打开。

由于我拥有不同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 - 数据连接有时会明显打开工作簿

2 个答案: