VBA - Extract name and a cell value of visible worksheets from closed workbook without opening it

[i_excel]

Hi

I am trying to populate some cells of a worksheet with the names and specific cell values (e.g. cell(1,1) of each worksheet) of a closed workbook without first opening it. The motivation for not opening it is to reduce processing time.

I have found code that partially meets the challenge - it can extract the name of all worksheets (visible and invisible). It follows below.

Any help would be much appreciated.

i_excel

Sub test11()

    Dim objConn As ADODB.Connection
    Dim objCat As ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim sConnString As String
    Dim sSheet As String
    Dim Col As New Collection
    
    Set objConn = New ADODB.Connection
    objConn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=test.xlsx; Extended Properties=Excel 12.0;"
    Set objCat = New ADOX.Catalog
    Set objCat.ActiveConnection = objConn
    
    For Each tbl In objCat.Tables
        'If tbl.Visible = True Then
            sSheet = tbl.Name
            sSheet = Application.Substitute(sSheet, "'", "")
            sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
            On Error Resume Next
            Col.Add sSheet, sSheet
            On Error GoTo 0
        'End If
    Next tbl
   
    
    objConn.Close
    Set objCat = Nothing
    Set objConn = Nothing
    
    For i = 1 To Col.Count
        Cells(24 + i, 2).Value = Col(i)
    Next i


End Sub

Apologies if this is posted in the wrong place - I am so new to this that I don't know what I'm dealing with.

 

[Worf]

See if this does what you want.
Tag for this thread: ADO connection.

Sub test11()
Dim objConn As ADODB.Connection, objCat As ADOX.Catalog, tbl As ADOX.Table, _
sConnString$, sSheet$, Col As New Collection, i%
Set objConn = New ADODB.Connection
objConn.Open _
"Provider=Microsoft.ACE.OLEDB.12.0; Data Source=c:\pub\erp.xlsm; Extended Properties=Excel 12.0;"
Set objCat = New ADOX.Catalog
Set objCat.ActiveConnection = objConn
For Each tbl In objCat.Tables
    sSheet = tbl.Name
    sSheet = Application.Substitute(sSheet, "'", "")
    sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
    On Error Resume Next
    Col.Add sSheet, sSheet
    On Error GoTo 0
Next
objConn.Close
Set objCat = Nothing
Set objConn = Nothing
For i = 1 To Col.count
    Cells(i, 2) = Col(i)                                                    ' sheet name
    Cells(i, 3) = GetValue("c:\pub", "erp.xlsm", CStr(Cells(i, 2)), "a1")   ' content of A1
Next
End Sub


Private Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
    GetValue = "File Not Found"
    Exit Function
End If
GetValue = ExecuteExcel4Macro("'" & path & "[" & file & "]" & sheet & _
"'!" & Range(ref).Range("A1").Address(, , xlR1C1))
End Function