VBAでADOでシート名を取得する場合 への返答
投稿で使用できる特殊コードの説明。(別タブで開きます。)
以下の返答は逆順(新しい順)に並んでいます。
投稿者 魔界の仮面弁士  (社会人)
投稿日時
2022/10/24 17:27:29
>> 列挙順が変化するワークブック
> だったら良かったのですが、手元では変わりませんでした・・・
その場合、Excel の Worksheets コレクションでも変化しない状況でしょうか。
> 正規表現は、自分でも使ってみているのですが、1.0と5.5があるのを知りませんでした。
Windows Scripting 5.5 に付随するライブラリですね。
バージョンが 5.5 なのは、2000年7月に公開された
Internet Explorer 5.5 とバージョンを揃えるためでしょう。
1.0 との違いは、SubMatches が使えるかどうかです。
https://qiita.com/Q11Q/items/56db596629a124f94b7e
> 辞書もまだ敷居が高くて使ってみていなかったです
今回 Dictionary を使ったのは、Print_Area の有無で結果が変わらないようにするためです。
別案として、Function の戻り値を As VBA.Collection にする方法もあるでしょう。
Dictionary は登録順に列挙されるようですが、削除と追加を繰り返した場合の
列挙順は保証されていません。一方 Collection は列挙順が保証されているのですが、
重複判定などは、Collection よりも Dictionary の方が便利だったりします。
> だったら良かったのですが、手元では変わりませんでした・・・
その場合、Excel の Worksheets コレクションでも変化しない状況でしょうか。
> 正規表現は、自分でも使ってみているのですが、1.0と5.5があるのを知りませんでした。
Windows Scripting 5.5 に付随するライブラリですね。
バージョンが 5.5 なのは、2000年7月に公開された
Internet Explorer 5.5 とバージョンを揃えるためでしょう。
1.0 との違いは、SubMatches が使えるかどうかです。
https://qiita.com/Q11Q/items/56db596629a124f94b7e
> 辞書もまだ敷居が高くて使ってみていなかったです
今回 Dictionary を使ったのは、Print_Area の有無で結果が変わらないようにするためです。
別案として、Function の戻り値を As VBA.Collection にする方法もあるでしょう。
Dictionary は登録順に列挙されるようですが、削除と追加を繰り返した場合の
列挙順は保証されていません。一方 Collection は列挙順が保証されているのですが、
重複判定などは、Collection よりも Dictionary の方が便利だったりします。
投稿者 snowmansnow  (社会人)
投稿日時
2022/10/24 14:57:00
こんにちは、魔界の仮面弁士様
詳しい説明ありがとうございます
>手元の環境でも、
> シート順を変更して保存すると列挙順が変化するワークブック
> シート順を変更して保存しても列挙順が変わらないワークブック
>と様々です。
色々調べていただきありがとうございます
> 列挙順が変化するワークブック
だったら良かったのですが、手元では変わりませんでした・・・
>Excel のバイナリーフォーマットは公開されているので、調べようとすれば
>Excel.Application を使うよりも早く列挙することができるかもしれませんが、
>それだけのために直接バイナリを扱うのは、あまり現実的では無さそうです。
zipとかxlmとか、ハードルが高そうでしたので、ダメだと思います。
(i-filterみたいな、table-filterみたいなのがあるといいなぁと思いました・・・)
>なお、snowmansnow さんの最初のコードにしても私の手法にしても、
>ファイルによっては、追加の作業が発生するようです。
ADOXとOpenSchemaで、両方できるようにして頂いたので、
OpenSchemaの勉強もしていきたいと思います。
シート名は、目検で確認してから、データを取得する方法で、いきたいと思います。
正規表現と辞書を使って頂きましたので、
勉強していきたいと思います。
(正規表現は、自分でも使ってみているのですが、1.0と5.5があるのを知りませんでした。
辞書もまだ敷居が高くて使ってみていなかったです)
諸事情で、数日、追加のお返事、確認しづらくなってしまいますが、
また宜しく御願い致します。
いつも、御教授ありがとうございます。
投稿者 魔界の仮面弁士  (社会人)
投稿日時
2022/10/24 11:48:41
> できれば開けずに、値を集約したかったです。
ADODB であれ Excel であれ OpenXML であれ ClosedXML であれ、
ファイルを開かないと中身が読み取れないという点は同じことですが、
数式や画像が多い場合は、Excel.Application だと時間がかかってしまうかもしれませんね。
>> ADOX の方は CreateObject を使わず、参照設定を必須にしている点に違和感があります。
> Dim adoCat As ADOX.Catalog
> または Set adoCat = CreateObject("ADOX.Catalog")
> に、修正する形でよろしいでしょうか?
そうですね。
ついでに言えば、「ADODB と ADOX の両方を参照しておく」か、
「いずれも参照設定しない状態」にする方が統一性が取れるでしょう。
(可能なら、参照して使う方法にしておいた方が良いとは思います)
> エクセルのシート順を変えても順が変わりません。
ADOX にしても adSchemaTables にしても、
列挙順については保証の限りでは無い、ということなのでしょう。
手元の環境でも、
シート順を変更して保存すると列挙順が変化するワークブック
シート順を変更して保存しても列挙順が変わらないワークブック
と様々です。
検証を重ねていないので、何が影響しているのかまでは特定しておりませんが、
いずれの方法も、「列挙順」に関しては、確実性のある列挙方法とは言い難いです。
Excel.Application 経由で調べる方法と比較すると、
正直、そこまでの厳密性は期待できなさそうですね。
Excel のバイナリーフォーマットは公開されているので、調べようとすれば
Excel.Application を使うよりも早く列挙することができるかもしれませんが、
それだけのために直接バイナリを扱うのは、あまり現実的では無さそうです。
なお、snowmansnow さんの最初のコードにしても私の手法にしても、
ファイルによっては、追加の作業が発生するようです。
手元にあった 3 シート構成のブックが 0~5 の 6 件のデータを返すことがありました。
そのケースでは .Worksheets(1).Name が "実施概要" だったのですが、
SNo = 0 → "実施概要$"
SNo = 1 → "実施概要$_xlnm#Print_Area"
といった形式で、の文字列を返してきました。
どうやら印刷範囲設定が、名前の定義として認識されているようですね。
また、.Worksheets(2).Name = "実施概要 (変更前)" に対しては
SNo = 2 → "'実施概要 (変更前)$'"
SNo = 3 → "'実施概要 (変更前)$'_xlnm#Print_Area"
のような文字列が返されるケースもありました。
末尾 $ だけでなく、両端シングルクォートも考慮せねばならないようです。
>> ReDim sheetNames(1 To rs.RecordCount)
> が、エラー(値が-1)になり、100決め打ちで
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Set cn = CreateObject("ADODB.Connection")
cn.CursorLocation = adUseClient
にした場合は正しい件数を返したのに対して
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
cn.CursorLocation = adUseServer
だと、-1 を返してきました。
どちらの場合も、rs.CursorLocation は adUseServer になりました。
RecordCount に頼るのも不安なので、配列ではなく Dictionary に加えていくか
rs.GetRows で取得した方が安全そうですね。
Print_Area 関連を除去するコードも加えると、こんな感じでどうでしょう。
この関数の戻り値は As String() ですが、
これを As Variant() にしても構わなければ、最後の行は
GetSheetNames = dict.Items()
だけで済みます。
また、名前以外の附帯情報が付いても構わない場合は GetRows を使うのが簡単です。
この場合、MoveNext や Dictionary も不要です。
このケースでは、戻り値が (列番号, 行番号) 形式の二次元配列となり、
TABLE_NAME は列番号 2 となります。
ADODB であれ Excel であれ OpenXML であれ ClosedXML であれ、
ファイルを開かないと中身が読み取れないという点は同じことですが、
数式や画像が多い場合は、Excel.Application だと時間がかかってしまうかもしれませんね。
>> ADOX の方は CreateObject を使わず、参照設定を必須にしている点に違和感があります。
> Dim adoCat As ADOX.Catalog
> または Set adoCat = CreateObject("ADOX.Catalog")
> に、修正する形でよろしいでしょうか?
そうですね。
ついでに言えば、「ADODB と ADOX の両方を参照しておく」か、
「いずれも参照設定しない状態」にする方が統一性が取れるでしょう。
(可能なら、参照して使う方法にしておいた方が良いとは思います)
> エクセルのシート順を変えても順が変わりません。
ADOX にしても adSchemaTables にしても、
列挙順については保証の限りでは無い、ということなのでしょう。
手元の環境でも、
シート順を変更して保存すると列挙順が変化するワークブック
シート順を変更して保存しても列挙順が変わらないワークブック
と様々です。
検証を重ねていないので、何が影響しているのかまでは特定しておりませんが、
いずれの方法も、「列挙順」に関しては、確実性のある列挙方法とは言い難いです。
Excel.Application 経由で調べる方法と比較すると、
正直、そこまでの厳密性は期待できなさそうですね。
Excel のバイナリーフォーマットは公開されているので、調べようとすれば
Excel.Application を使うよりも早く列挙することができるかもしれませんが、
それだけのために直接バイナリを扱うのは、あまり現実的では無さそうです。
なお、snowmansnow さんの最初のコードにしても私の手法にしても、
ファイルによっては、追加の作業が発生するようです。
手元にあった 3 シート構成のブックが 0~5 の 6 件のデータを返すことがありました。
そのケースでは .Worksheets(1).Name が "実施概要" だったのですが、
SNo = 0 → "実施概要$"
SNo = 1 → "実施概要$_xlnm#Print_Area"
といった形式で、の文字列を返してきました。
どうやら印刷範囲設定が、名前の定義として認識されているようですね。
また、.Worksheets(2).Name = "実施概要 (変更前)" に対しては
SNo = 2 → "'実施概要 (変更前)$'"
SNo = 3 → "'実施概要 (変更前)$'_xlnm#Print_Area"
のような文字列が返されるケースもありました。
末尾 $ だけでなく、両端シングルクォートも考慮せねばならないようです。
>> ReDim sheetNames(1 To rs.RecordCount)
> が、エラー(値が-1)になり、100決め打ちで
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Set cn = CreateObject("ADODB.Connection")
cn.CursorLocation = adUseClient
にした場合は正しい件数を返したのに対して
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
cn.CursorLocation = adUseServer
だと、-1 を返してきました。
どちらの場合も、rs.CursorLocation は adUseServer になりました。
RecordCount に頼るのも不安なので、配列ではなく Dictionary に加えていくか
rs.GetRows で取得した方が安全そうですね。
Print_Area 関連を除去するコードも加えると、こんな感じでどうでしょう。
'シート名の一覧を返す(列挙順は保証できない)
Function GetSheetNames(ByVal excelFile As String) As String()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Provider = "Microsoft.ACE.OLEDB.12.0"
cn.Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
cn.Open excelFile
Set rs = cn.OpenSchema(adSchemaTables)
Dim re As VBScript_RegExp_55.RegExp
Dim ms As VBScript_RegExp_55.MatchCollection, rm As VBScript_RegExp_55.Match
Set re = New VBScript_RegExp_55.RegExp
re.Pattern = "^'?(.*)\$'?(#Print_Area|_xlnm#Print_Area)?$"
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
Dim tableName As String
Do Until rs.EOF
tableName = rs.Collect("TABLE_NAME")
'各種接尾辞を削ぎ落す
Set ms = re.Execute(tableName)
If ms.Count > 0 Then
Set rm = ms.Item(0)
tableName = rm.SubMatches(0)
Else
Debug.Print tableName
End If
dict(tableName) = CByte(0)
rs.MoveNext
Loop
rs.Close
cn.Close
'「内部型式が String なバリアント型の一次元配列」を「文字列型の一次元配列」に変換
GetSheetNames = Split(Join(dict.Keys(), vbNullChar), vbNullChar)
End Function
この関数の戻り値は As String() ですが、
これを As Variant() にしても構わなければ、最後の行は
GetSheetNames = dict.Items()
だけで済みます。
また、名前以外の附帯情報が付いても構わない場合は GetRows を使うのが簡単です。
この場合、MoveNext や Dictionary も不要です。
Set rs = cn.OpenSchema(adSchemaTables)
GetSheetNames = rs.GetRows(-1) '二次元配列として返却
rs.Close
cn.Close
このケースでは、戻り値が (列番号, 行番号) 形式の二次元配列となり、
TABLE_NAME は列番号 2 となります。
0: TABLE_CATALOG
1: TABLE_SCHEMA
2: TABLE_NAME これが今回求める名前★
3: TABLE_TYPE 今回は全件 "TABLE" のはず
4: TABLE_GUID
5: DESCRIPTION
6: TABLE_PROPID
7: DATE_CREATED 作成日時
8: DATE_MODIFIED 更新日時
1: TABLE_SCHEMA
2: TABLE_NAME これが今回求める名前★
3: TABLE_TYPE 今回は全件 "TABLE" のはず
4: TABLE_GUID
5: DESCRIPTION
6: TABLE_PROPID
7: DATE_CREATED 作成日時
8: DATE_MODIFIED 更新日時
投稿者 snowmansnow  (社会人)
投稿日時
2022/10/21 21:18:31
こんばんは、いつもありがとうございます
>CreateObject("Excel.Application") では都合が悪いという状況でしょうか。
いっぱいほぼ一緒の形式のファイルがあり、値もほぼ一緒の位置にあります。
できれば開けずに、値を集約したかったです。
>> ワークブックの一番左のシート名の取得
>> (sheets(0).name みたいな)
>Excel のワークシートは 1 から始まるものだったはずでは…?
これは、自分でも気づいて修正させていただきました。
>> Set adoCat = New ADOX.Catalog
>ADODB は参照設定なしで動くようにしているのに、
>ADOX の方は CreateObject を使わず、参照設定を必須にしている点に違和感があります。
Dim adoCat As ADOX.Catalog
または Set adoCat = CreateObject("ADOX.Catalog")
に、修正する形でよろしいでしょうか?
>試しに、シート名の配列を返すようにしてみました。
>今回は Excel のように 1 から始まる番号で返すようにしています。
シート名で並び替え済なのか、エクセルのシート順を変えても順が変わりません。
シートがA、B、Cという並びでも
シートがC、A、Bという並びでも
A
B
C
というように返してくるようでした
シートがA、B、Cという並びでは
A
B
C
シートがC、A、Bという並びでは
C
A
B
を返すようにならないでしょうか?
自分のADOXでも、SNoを調節しなくては、目的の値が取得できていません。
あるファイルでは、SNo=1、あるファイルでは、SNo=2というように
>ReDim sheetNames(1 To rs.RecordCount)
が、エラー(値が-1)になり、100決め打ちでエラー回避してみました。
投稿者 魔界の仮面弁士  (社会人)
投稿日時
2022/10/21 16:28:00
> VBAでADOでシート名を取得する場合の質問をさせて頂きたいです
CreateObject("Excel.Application") では都合が悪いという状況でしょうか。
> ワークブックの一番左のシート名の取得
> (sheets(0).name みたいな)
Excel のワークシートは 1 から始まるものだったはずでは…?
現状のコードだと、引数の SNo As Long が、そのインデックスにあたると思います。
ただしこちらは 0 から始まる番号です。
また、OLE DB Provider 側の仕様で、シート名の末尾に $ を付けた名前として返却されます。
> Set adoCat = New ADOX.Catalog
ADODB は参照設定なしで動くようにしているのに、
ADOX の方は CreateObject を使わず、参照設定を必須にしている点に違和感があります。
そもそも参照設定しているのなら、 As Object にするのではなく、
それぞれの固有型の変数として宣言した方が良いと思いますよ。
あるいは、ADOX を使わないスタイルもありますね。
(スキーマを取得するという点では同じことですが)
試しに、シート名の配列を返すようにしてみました。
今回は Excel のように 1 から始まる番号で返すようにしています。
CreateObject("Excel.Application") では都合が悪いという状況でしょうか。
> ワークブックの一番左のシート名の取得
> (sheets(0).name みたいな)
Excel のワークシートは 1 から始まるものだったはずでは…?
現状のコードだと、引数の SNo As Long が、そのインデックスにあたると思います。
ただしこちらは 0 から始まる番号です。
また、OLE DB Provider 側の仕様で、シート名の末尾に $ を付けた名前として返却されます。
> Set adoCat = New ADOX.Catalog
ADODB は参照設定なしで動くようにしているのに、
ADOX の方は CreateObject を使わず、参照設定を必須にしている点に違和感があります。
そもそも参照設定しているのなら、 As Object にするのではなく、
それぞれの固有型の変数として宣言した方が良いと思いますよ。
あるいは、ADOX を使わないスタイルもありますね。
(スキーマを取得するという点では同じことですが)
試しに、シート名の配列を返すようにしてみました。
今回は Excel のように 1 から始まる番号で返すようにしています。
Function GetSheetNames(ByVal excelFile As String) As String()
Dim sheetNames() As String
Const adUseClient As Long = 3&
Const adSchemaTables As Long = &H14&
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
cn.Provider = "Microsoft.ACE.OLEDB.12.0"
cn.Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
cn.Open excelFile
Set rs = cn.OpenSchema(adSchemaTables) 'ADOX を使わずにスキーマを取得
ReDim sheetNames(1 To rs.RecordCount)
Dim idx As Long
idx = 0&
Do Until rs.EOF
idx = idx + 1&
sheetNames(idx) = rs.Collect("TABLE_NAME")
If sheetNames(idx) Like "*$" Then '末尾の $ を除去
sheetNames(idx) = Left(sheetNames(idx), Len(sheetNames(idx)) - 1)
End If
rs.MoveNext
Loop
rs.Close
cn.Close
Set GetSheetNames = sheetNames
End Function
投稿者 snowmansnow  (社会人)
投稿日時
2022/10/21 16:12:26
ごめんなさい
> sheets(0).name みたいに
でなくて
sheets(1).name みたいに
でした
ごめんなさい
エクセル2016の64bit、win10です
投稿者 snowmansnow  (社会人)
投稿日時
2022/10/21 15:08:27
こんにちは
VBAでADOでシート名を取得する場合の質問をさせて頂きたいです
FileN = C:\ほげほげ\エクセル.xlsm
SNo = シートNo ※これが、
Function MyADOExcel666(FileN As String, SNo As Long)
Dim cn As Object
Dim rs As Object
Dim adoCat As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Provider = "Microsoft.ACE.OLEDB.12.0"
cn.Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
cn.Open FileN
Set adoCat = New ADOX.Catalog
Set adoCat.ActiveConnection = cn
MyADOExcel666 = adoCat.Tables(SNo).Name
' rs.Close
' Set rs = Nothing
' cn.Close
' Set cn = Nothing
End Function
のようなコードで、一応シート名は取得できるようなのですが、
ワークブックの一番左のシート名の取得
(sheets(0).name みたいな)
というような、シート名は、どのように取得したら良いのでしょうか?
よろしくお願いします。
こんにちは、魔界の仮面弁士様、るきお様
諸事情で、お返事できず申し訳ございませんでした。
>> 列挙順が変化するワークブック
>> だったら良かったのですが、手元では変わりませんでした・・・
>その場合、Excel の Worksheets コレクションでも変化しない状況でしょうか。
はい、sheets(1).nameは、変わります。
>1.0 との違いは、SubMatches が使えるかどうかです。
.submatches(0)とか使った事がありますので、知らずに5.5を使っていたかもしれません。
>Dictionary は登録順に列挙されるようですが、削除と追加を繰り返した場合の
>列挙順は保証されていません。一方 Collection は列挙順が保証されているのですが、
>重複判定などは、Collection よりも Dictionary の方が便利だったりします。
機会がありましたら、使ってみたいです。
久しぶりにパソコン触れましたので、諸先輩方の例を参考にVB.NETでシート名羅列を作ってみました
よろしかったら見てやって下さい
(フォームにマルチラインのテキストボックスとボタン1個配置します)
よろしくお願いします。