■xlsブックのSheet一覧(ADO)

前回、前フリしましたが(...したっけ？:-)
[ActiveX Data Objects (ADO)]を使ってSheet一覧を取得してみます。
Workbooks.Openメソッドで開いて処理するほうが安定していて確実だと思いますし、後述の理由で、実用的でない方法かもしれません。
『[HOWTO] Visual Basic または VBA から ADO を Excel データで使用する』この記事や
『ADOを使ってExcelのシート名を高速に取得する』このサイトを参考にさせて頂きました。

Sub try()
　　Const adSchemaTables As Long = 20
　　Dim Ado　　As Object
　　Dim AdoRs　As Object
　　Dim Reg　　As Object
　　Dim bkName As String
　　Dim tbName As String
　　Dim fdName As String
　　Dim fn　　 As String
　　Dim re　　 As String
　　Dim i　　　As Long
　　Dim n　　　As Long
　　Dim v(0 To 65535, 1 To 2)
　　Dim t As Single

　　t = Timer
　　On Error GoTo errHndlr
　　fdName = "D:¥test¥"
　　v(0, 1) = "BookName"
　　v(0, 2) = "SheetName"
　　Set Ado = CreateObject("ADODB.Connection")
　　Ado.Provider = "Microsoft.Jet.OLEDB.4.0"
　　Ado.Properties("Extended Properties") = "Excel 8.0"
　　Set Reg = CreateObject("VBScript.RegExp")
　　Reg.Pattern = "(.*)(¥$'|¥$)$"
　　fn = Dir(fdName & "*.xls")
　　Do Until Len(fn) = 0&
　　　　bkName = fdName & fn
　　　　On Error Resume Next
　　　　Ado.Properties("Data Source") = bkName
　　　　Ado.Open
　　　　If Err.Number = 0& Then
　　　　　　Set AdoRs = Ado.OpenSchema(adSchemaTables)
　　　　　　i = i + 1
　　　　　　Do Until AdoRs.EOF Or (n > 65535)
　　　　　　　　If AdoRs Is Nothing Then Exit Do
　　　　　　　　tbName = AdoRs.Fields("TABLE_NAME").Value
　　　　　　　　With Reg.Execute(tbName)
　　　　　　　　　　If .Count > 0& Then
　　　　　　　　　　　　n = n + 1
　　　　　　　　　　　　v(n, 1) = bkName
　　　　　　　　　　　　v(n, 2) = .Item(0).SubMatches(0)
　　　　　　　　　　End If
　　　　　　　　End With
　　　　　　　　AdoRs.MoveNext
　　　　　　Loop
　　　　　　AdoRs.Close
　　　　　　Ado.Close
　　　　End If
　　　　Err.Clear
　　　　fn = Dir()
　　Loop
　　If i > 0& Then
　　　　Sheets.Add.Range("A1").Resize(n + 1, 2).Formula = v
　　End If
errHndlr:
　　If Err.Number = 0& Then
　　　　re = i & " Books & " & n & " Sheets was listed."
　　Else
　　　　re = Err.Number & vbLf & Err.Description
　　End If
　　Erase v
　　Set AdoRs = Nothing
　　Set Ado = Nothing
　　Set Reg = Nothing
　　Debug.Print i, n, Timer - t
　　MsgBox re
End Sub

（ぅーん...エラー処理甘いような...サンプルなのでご勘弁）

適当なフォルダに適当なxlsブック100ファイル、約300シートを読み込むのに、Workbooks.Openメソッドでは約30sec程かかります。（環境やファイルサイズによりますが）
対して、ADOで読み込むと約1/3の時間で読み込みできます。


...ですが上記コードは欠点があります。非表示のシートは読めません...orz
...さて、どうしたものか...って事で（当分の間）課題にしておきます。 X-(