首页 > 解决方案 > 如何在不打开的情况下检查关闭的工作簿的工作表中是否存在表格

问题描述

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

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

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

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

我找到了一些代码片段,但我无法让它们中的任何一个在文件关闭时给我一个关于工作表和表格是否存在于文件中的 True/False。

检查外部关闭的工作簿中是否存在工作表

Excel VBA - 根据单元格地址获取表格名称

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

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

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

标签: excelvba

解决方案


假设我们的 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

推荐阅读