ray88’s diary

お仕事で困ったとき用の自分用の覚書

ファイルを開かずにシート名をまとめて取得する

■以下コードでファイルを開かずにシート名をまとめて取得できる
呼び出し元コード

Sub 対象ファイルのシート名を取得()
Dim arrSheetName() As String
Dim strPath As String
Dim i As Long

strPath = "C:\Users\デスクトップ\test.xlsx"
arrSheetName = fncGetSheets(strPath)

For i = 0 To UBound(arrSheetName)
    Debug.Print arrSheetName(i)
Next

End Sub

呼び出し先コード

Function fncGetSheets(strFilePath As String) As String()
'----------------------------------------------------------
'機 能:指定してファイルパス内のシート名を取得し配列にして返す
'引 数:対象ファイルパス
'戻り値:シート名の配列
'----------------------------------------------------------
    Dim objCn As Object
    Dim objRs As Object
    'Dim strFile As String
    Dim sSheet As String
    Dim i As Long
    Dim arrSheets() As String
'----------------------------------------------------------
    Set objCn = CreateObject("ADODB.Connection")
    Set objRs = CreateObject("ADODB.Recordset")
    
    With objCn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0"
        .Open strFilePath
        'ADODBを遅延バインディングしているためOpanSchemaの
        '定数「adSchemaTables」を値の「20」で指定する
        Set objRs = .OpenSchema(20)
    End With
   '--------------------------------------------------------
    i = 1
    Do Until objRs.EOF
        ReDim Preserve arrSheets(i - 1)
        sSheet = objRs.Fields("TABLE_NAME").Value
        If Right(sSheet, 1) = "$" Or Right(sSheet, 2) = "$'" Then
            If Right(sSheet, 1) = "$" Then
                sSheet = Left(sSheet, Len(sSheet) - 1)
            End If
            If Right(sSheet, 2) = "$'" Then
                sSheet = Left(sSheet, Len(sSheet) - 2)
            End If
            If Left(sSheet, 1) = "'" Then
                sSheet = Mid(sSheet, 2)
            End If
            sSheet = Replace(sSheet, "''", "'")
            arrSheets(i - 1) = sSheet
            i = i + 1
        End If
        objRs.MoveNext
    Loop
    objRs.Close
    objCn.Close
    Set objRs = Nothing
    Set objCn = Nothing
    fncGetSheets = arrSheets
End Function

※参考URL
Excelファイルを開かずにシート名を取得|VBAサンプル集
OpenSchema メソッド (ADO) | Microsoft Docs
SchemaEnum (Access デスクトップ データベースリファレンス) | Microsoft Docs