Hello,
I have a VBA script to list worksheets from a closed workbook. The script works great, but I can't seem to get it to list the file location and name. Does anyone have an idea about how I could get the file path and name to show up? Thanks!
I have a VBA script to list worksheets from a closed workbook. The script works great, but I can't seem to get it to list the file location and name. Does anyone have an idea about how I could get the file path and name to show up? Thanks!
Code:
Option Explicit
Public Sub DemoGetSheetNames()
Dim lNumEntries As Long
Dim szFullName As String
Dim szFileSpec As String
Dim szFileName As String
Dim aszSheetList() As String
Sheet1.UsedRange.Select
szFileSpec = "Excel Files (*.xl*),*.xl"
szFullName = CStr(Application.GetOpenFilename(szFileSpec, , "Select an Excel File"))
''' Continue if the user did not cancel the dialog.
If szFullName <> CStr(False) Then
GetSheetNames szFullName, aszSheetList()
lNumEntries = UBound(aszSheetList) - LBound(aszSheetList) + 1
Sheet1.Range("A1").Resize(lNumEntries).Value = Application.WorksheetFunction.Transpose(aszSheetList())
Sheet1.Range("A1").EntireColumn.AutoFit
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments: Returns a string array containing the list of worksheets in
''' the specified workbook.
''' NOTE: Requires references to the following object library:
''' * Microsoft ActiveX Data Objects 2.5 Library (or higher version)
'''
''' Arguments: szFullName [in] The full path and filename of the workbook
''' whose worksheet list you want to query.
''' aszSheetList() [out] Will be loaded with a list of worksheets
''' in the workbook specified by szFullName.
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 05/13/05 Rob Bovey Created
'''
Private Sub GetSheetNames(ByRef szFullName As String, ByRef aszSheetList() As String)
Dim bIsWorksheet As Boolean
Dim objConnection As ADODB.Connection
Dim rsData As ADODB.Recordset
Dim lIndex As Long
Dim szConnect As String
Dim szSheetName As String
Erase aszSheetList()
If Application.Version < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & szFullName & ";Extended Properties=Excel 8.0;"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & szFullName & ";Extended Properties=Excel 8.0;"
End If
Set objConnection = New ADODB.Connection
objConnection.Open szConnect
Set rsData = objConnection.OpenSchema(adSchemaTables)
Do While Not rsData.EOF
bIsWorksheet = False
szSheetName = rsData.Fields("TABLE_NAME").Value
If Right$(szSheetName, 1) = "$" Then
''' This is a simple sheet name. Remove the trailing "$" and continue.
szSheetName = Left$(szSheetName, Len(szSheetName) - 1)
bIsWorksheet = True
ElseIf Right$(szSheetName, 2) = "$'" Then
''' This is a sheet name with spaces and/or special characters.
''' Remove the right "&'" characters.
szSheetName = Left$(szSheetName, Len(szSheetName) - 2)
''' Remove the left single quote character.
szSheetName = Right$(szSheetName, Len(szSheetName) - 1)
bIsWorksheet = True
End If
If bIsWorksheet Then
''' Embedded single quotes in the sheet name will be doubled up.
''' Replace any doubled single quotes with one single quote.
szSheetName = Replace$(szSheetName, "''", "'")
''' Load the processed sheet name into the array.
ReDim Preserve aszSheetList(0 To lIndex)
aszSheetList(lIndex) = szSheetName
lIndex = lIndex + 1
End If
rsData.MoveNext
Loop
rsData.Close
Set rsData = Nothing
objConnection.Close
Set objConnection = Nothing
End Sub