Miguel Lima
Miguel Lima

Reputation: 23

How to check if a table exists in a sheet in a closed workbook without opening it

I have a macro that compiles rows within tables across multiple files. All files are essentially copies of the "master" file. Each file is used by a different person.

The rows to copy are on "Table_Data" in "Tracker" sheet, with these names being stored in constant variables.

The macro first checks if the pre-defined list of individual files exist in the same folder and are not open.
Once that check is passed, the files are opened one by one, with all data in the table read into an array.
That array is looped through to copy rows, that fit certain requirements, into a compiled array.
Once that is done, the array is emptied, file #1 is closed and file #2 is opened to repeat the above step.
Once all required rows have been copied into the compiled array, the array is pasted in the master file.

As part of error checking, I want to check if the pre-defined list of files have the correct sheetname and the correct table name inside that sheet, BEFORE opening the file. If one of the files is not valid, I don't want the compiler to start.

I found snippets of code, but I haven't been able to make any of them give me a True/False on whether or not the sheet and table exist on the file while the file is closed.

Checking If A Sheet Exists In An External Closed Workbook

Excel VBA - Get name of table based on cell address

I have this, however, the file has to be opened, which slows down the macro. To save time, I call it before copying the rows from each file and if the file is not valid, do not compile and show message stating which files are not valid.

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

I want this check before opening the files.

Upvotes: 2

Views: 627

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149287

Let's say our excel file looks like this

enter image description here

Logic:

  1. Copy the excel file to user temp directory and rename it to say "Test.Zip"
  2. Unzip the Zip files
  3. We will keep our attention to 2 different folders. \xl\worksheets and \xl\tables. This is where the xml files are created.
  4. \xl\worksheets If a sheet exists then an xml will be created with that name as shown below.

    enter image description here

  5. \xl\tables If a table exists then an xml will be created as shown below. However in this case, it is not necessary that the name of the table will be the same as the file name. However the name of the table will be inside the xml file as shown below

    enter image description here

    and this is the content of the 2nd xml file.

    enter image description here

  6. So simply check if the xml file exists for the sheet and for the table, check the contents of the file.

Code:

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

Upvotes: 2

Related Questions