excel - 如何在不打开工作簿的情况下检查表格是否存在于关闭的工作簿中的工作表中

Question

我有一个宏，可以跨多个文件编译表中的行。所有文件本质上都是“主”文件的副本。每个文件由不同的人使用。

要复制的行位于“Tracker”表中的“Table_Data”上，这些名称存储在常量变量中。

宏首先检查预定义的各个文件列表是否存在于同一文件夹中并且未打开。
一旦通过检查，文件就会被逐个打开，并将表中的所有数据读入数组。
循环该数组以将符合特定要求的行复制到已编译的数组中。
完成后，数组将被清空，文件#1 被关闭，文件#2 被打开以重复上述步骤。
将所有必需的行复制到已编译的数组中后，该数组就会粘贴到主文件中。

作为错误检查的一部分，我想在打开文件之前检查预定义的文件列表是否具有正确的工作表名称以及该工作表内的正确表名称。如果其中一个文件无效，我不希望编译器启动。

我找到了代码片段，但我无法让其中任何一个片段判断文件关闭时工作表和表格是否存在于文件中。

Checking If A Sheet Exists In An External Closed Workbook

Excel VBA - Get name of table based on cell address

我有这个，但是，必须打开该文件，这会减慢宏的速度。为了节省时间，我在从每个文件复制行之前调用它，如果文件无效，则不编译并显示说明哪些文件无效的消息。

Option Explicit
Function IsFileValid(ByVal strFileName As String) As Boolean
    Dim wb As Workbook
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & strFileName, True, True)

    On Error Resume Next
    If Worksheets(wrkshtTracker).ListObjects(tableTracker).Range(1, 2) = strEmailHeader Then
        IsFileValid = True
    End If
    wb.Close False
    Set wb = Nothing
    On Error GoTo 0
    Application.ScreenUpdating = True
End Function

我希望在打开文件之前进行此检查。

Answer 1

假设我们的 Excel 文件如下所示

逻辑:

1. 将 Excel 文件复制到用户临时目录并将其重命名为“Test.Zip”
2. 解压 Zip 文件
3. 我们将关注 2 个不同的文件夹。 \xl\worksheets 和 \xl\tables。这是创建 xml 文件的位置。

4. \xl\worksheets 如果工作表存在，则将使用该名称创建一个 xml，如下所示。

   

5. \xl\tables 如果表存在，则将创建一个 xml，如下所示。但是在这种情况下，表名不必与文件名相同。但是表的名称将位于 xml 文件内，如下所示

   

   这是第二个 xml 文件的内容。

   

6. 因此，只需检查工作表和表格的 xml 文件是否存在，检查文件的内容。

代码:

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Dim zipFilePath As Variant
Dim tmpDir As Variant
Dim filePath As String
Dim oApp As Object
Dim StrFile As String

Sub Sample()
    filePath = "C:\Users\routs\Desktop\sid.xlsx"
    tmpDir = TempPath & Format(Now, "ddmmyyhhmmss")
    zipFilePath = tmpDir & "\Test.Zip"

    MsgBox DoesSheetExist("Sheet1")
    MsgBox DoesTableExist("Table13")
End Sub

'~~> Function to check if a sheet exists
Private Function DoesSheetExist(wsName As String) As Boolean
    MkDir tmpDir

    FileCopy filePath, zipFilePath

    Set oApp = CreateObject("Shell.Application")

    oApp.Namespace(tmpDir & "\").CopyHere oApp.Namespace(zipFilePath).items

    If Dir(tmpDir & "\xl\worksheets", vbDirectory) <> "" Then
        StrFile = Dir(tmpDir & "\xl\worksheets\*.xml")
        Do While Len(StrFile) > 0
            If UCase(Left(StrFile, (InStrRev(StrFile, ".", -1, vbTextCompare) - 1))) = UCase(wsName) Then
                DoesSheetExist = True
                Exit Do
            End If
            StrFile = Dir
        Loop
    End If

    If Len(Dir(tmpDir, vbDirectory)) <> 0 Then
        CreateObject("Scripting.FileSystemObject").DeleteFolder tmpDir
    End If
End Function

'~~> Function to check if a table exists
Private Function DoesTableExist(tblName As String) As Boolean
    Dim MyData As String, strData() As String
    Dim stringToSearch As String

    stringToSearch = "name=" & Chr(34) & tblName & Chr(34)
    MkDir tmpDir

    FileCopy filePath, zipFilePath

    Set oApp = CreateObject("Shell.Application")

    oApp.Namespace(tmpDir & "\").CopyHere oApp.Namespace(zipFilePath).items

    If Dir(tmpDir & "\xl\tables", vbDirectory) <> "" Then
        StrFile = Dir(tmpDir & "\xl\tables\*.xml")
        Do While Len(StrFile) > 0
            Open tmpDir & "\xl\tables\" & StrFile For Binary As #1
            MyData = Space$(LOF(1))
            Get #1, , MyData
            Close #1

            If InStr(1, MyData, stringToSearch, vbTextCompare) Then
                DoesTableExist = True
                Exit Do
            End If

            StrFile = Dir
        Loop
    End If

    If Len(Dir(tmpDir, vbDirectory)) <> 0 Then
        CreateObject("Scripting.FileSystemObject").DeleteFolder tmpDir
    End If
End Function

'~~> Function to get user temp directory
Private Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function