Excelのワークシート名取得 ADOでOpenSchema と Workbooks.Open を比べてみた

ADOというとデータベースに使うというイメージが強いような感じがしますが、Excelに対しても使えます。

Excelのワークブックを指定して、ワークシート名の一覧取得を、ADOの使用有無で行ってみます。

使用環境

Windows 10 Home
Excel 2013
CPU：古い（恥ずかしいので秘密）
メモリ：少し（同上）

使用する環境によっては、参照設定や接続文字列が変えないといけない場合がありえますのでご注意ください。

ADOを使用する場合

参照設定

最初に、参照設定を行います。
Microsoft ActiveX Datta Object 6.1 Library
にチェックを入れておきます。

モジュールレベルの変数

コネクション変数をモジュールレベルで宣言しておきます。
モジュール内で、共用するためです。

Private cn_     As ADODB.Connection

接続

Public Function connectDB(ByVal sDBPath As String, Optional ByVal bExistsHeaderRow As Boolean = True) As Long

    Dim sExistsHeaderRow    As String
    Dim sConnectionString   As String

    If bExistsHeaderRow = True Then
        sExistsHeaderRow = "Yes"
    Else
        sExistsHeaderRow = "No"
    End If

'    HDR=Yes===>先頭行を列名とみなす
'    『IMEX=1』とはドライバにインポート モードを使用するように指示して
'    混在データが文字列に変換されることを強制するものらしい
    sConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & sDBPath & ";" & _
                        "Extended Properties=""Excel 12.0 Xml;" & _
                                "HDR=" & sExistsHeaderRow & ";" & _
                                "IMEX=1;"""

On Error GoTo ERR_CONNECT_DB

    If cn_ Is Nothing Then
        Set cn_ = New ADODB.Connection
    End If

    If cn_.State <> adStateOpen Then
        cn_.Open sConnectionString
    End If

    connectDB = 0

    Exit Function

ERR_CONNECT_DB:
    Debug.Print Err.Number & ":" & Err.Description

    connectDB = Err.Number

End Function

切断

Public Sub disconnectDB()

    If Not cn_ Is Nothing Then
        If cn_.State <> adStateClosed Then
            cn_.Close
        End If

        Set cn_ = Nothing
    End If

End Sub

シート名取得

Public Function getSheetNames(ByRef sSheetNames() As String) As Long

    Dim rs          As ADODB.Recordset
    Dim fld         As ADODB.Field
    Dim lCount      As Long
    Dim sTableName  As String

    getSheetNames = 0

On Error GoTo ERR_GET_SHEET_NAMES

    Set rs = cn_.OpenSchema(adSchemaTables)

    lCount = 0

    ReDim sSheetNames(lCount)

    Do Until (rs.EOF)
        sTableName = rs.Fields("TABLE_NAME").Value

        If Right$(sTableName, 1) = "$" Then
            '定義された名前には、"$"が付かない
            'オートフィルタや、印刷範囲の指定等により、"_xlnm#"を含む名前が出てくる場合があるので
            'それらは無視する

            '末尾の"$"を除去
            sTableName = Left$(sTableName, Len(sTableName) - 1)

            ReDim Preserve sSheetNames(lCount)

            sSheetNames(lCount) = sTableName

            lCount = lCount + 1
        End If

        rs.MoveNext
    Loop

ERR_GET_SHEET_NAMES:
    If Err.Number <> 0 Then
        getSheetNames = -Err.Number
    Else
        getSheetNames = lCount
    End If

    If Not rs Is Nothing Then
        If rs.State <> adStateClosed Then
            rs.Close
        End If

        Set rs = Nothing
    End If
 
End Function

呼び出し

Public Sub getTargetSheetNameADO()

    Dim sTargetPath     As String
    Dim sSheetNames()   As String
    Dim i               As Long

    Dim sgStart         As Single
    Dim sgStop          As Single

    sgStart = Timer

    'シート名を取得するファイルのパス
    sTargetPath = "C:\Datas\大量データ.xlsm"

    Call connectDB(sTargetPath)

    Call getSheetNames(sSheetNames)

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

    Debug.Print ""

    Call disconnectDB

    sgStop = Timer

    Debug.Print "ADO     : " & Format$(sgStop - sgStart, "0.00 sec.")

End Sub

呼び出すファイルがマクロありなのは気にしないでください。

ADOを使用しない（Workbooks.Open + For Each）

こっちは、接続とか切断とかないので、いきなり呼び出して処理

Public Sub getTargetSheetNameForEach()

    Dim wb              As Workbook
    Dim ws              As Worksheet
    Dim sTargetPath     As String
    Dim i               As Long

    Dim sgStart         As Single
    Dim sgStop          As Single

    sgStart = Timer

    Application.ScreenUpdating = False

    'シート名を取得するファイルのパス
    sTargetPath = "C:\Datas\大量データ.xlsm"

    Set wb = Workbooks.Open(Filename:=sTargetPath, ReadOnly:=True)

    Debug.Print "  Opend : " & Format$(Timer - sgStart, "0.00 sec.")

    For Each ws In wb.Worksheets
        Debug.Print ws.Name
    Next ws

    Debug.Print ""

    wb.Close
    Set wb = Nothing

    Application.ScreenUpdating = True

    sgStop = Timer

    Debug.Print "ForEach : " & Format$(sgStop - sgStart, "0.00 sec.")

End Sub

サンプルデータ１

５０万件のデータが入ったやつ。
ファイルサイズは54MBくらい。

実行結果

call getTargetSheetNameADO
Data
FilterCondition
Key
Result
Sheet1
総合結果

ADO     : 0.09 sec.

call getTargetSheetNameForEach
  Opend : 8.80 sec.
Data
FilterCondition
Key
Result
総合結果
Sheet1

ForEach : 9.25 sec.

サンプルデータ２

６万件のデータが入ったやつ。
ファイルサイズは1.1MBくらい。

実行結果

call getTargetSheetNameADO
Sheet1
Sheet2

ADO     : 0.09 sec.

call getTargetSheetNameForEach
  Opend : 0.77 sec.
Sheet1
Sheet2

ForEach : 1.08 sec.

ADOの圧勝
サンプル１の方では、２桁違うよ。
サンプル２でも、１桁違う。

Workbooks.Openがボトルネック。ファイルサイズが大きいほど効いてくる。
ADO OpenSchemaは、ファイルサイズに依存していない。

ちなみに、サンプル１では、Sheet1は非表示になっていますが、どちらも取得できています。
データの並びが違うのがちょっと気になる・・・

最後に

お気軽に取得したいのなら、コードが簡単な
　Workbooks.Open + For Each
速度絶対優先なら、コードが面倒くさくても
　ADO OpenSchema
となるんでしょうね。

2019/4/8追記
今回の例は、シート名の取得のみの結果です。
ワークシート上のデータを取得するとなると、話は変わってきて、ADOのレコードセットでも、データ数に応じて、それなり（Workbooks.Openと同じくらい？のイメージ？）に時間がかかります。
興味のある人は、ご自分で試してみてください。

エラー発生時の復帰値が統一性がない・・・
Functionにしてるのに復帰値使ってないし・・・
何も考えないでコーディングしてるのがバレバレ