ブックを開かずに対象ブックのシート名リストを配列で取得する関数

要・参照設定：Microsoft ActiveX Data Objects ライブラリ

Function fncGetExcelWorksheetNames(strFilePath As String) As Variant
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strCon As String
    Dim arrSheetNames() As String
    Dim i As Integer

    ' 接続文字列をファイル形式に基づいて設定
    Select Case LCase(Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, ".")))
        Case "xls"
            ' Excel 97-2003 ファイル形式
            strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFilePath & ";Extended Properties=""Excel 8.0;HDR=NO;"""
        Case "xlsx", "xlsm"
            ' Excel 2007 以降のファイル形式
            strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;"""
    End Select

    ' ADO接続オブジェクトを作成
    Set cn = New ADODB.Connection
    cn.Open strCon

    ' ワークシート名を取得
    Set rs = cn.OpenSchema(adSchemaTables)
    i = 0
    Do While Not rs.EOF
        ReDim Preserve arrSheetNames(i)
        arrSheetNames(i) = Replace(rs.Fields("TABLE_NAME").Value, "$", "")
        i = i + 1
        rs.MoveNext
    Loop
    rs.Close

    ' オブジェクトを閉じて解放
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

    fncGetExcelWorksheetNames = arrSheetNames
End Function