VBAで非表示のブックからシートの名前だけ抽出する方法

質問

WindowsとExcel2003を使用しています。

(1)まず、VBAでフォームを作成しその上にリストボックスを1つ作ります。
(2)そのリストボックス内に自フォルダにあるファイル名の一覧を表示します。
(3)その一覧から1つだけエクセルファイルを選択し、実行ボタンをクリックすると新しいフォームが開きます。
(4)そのフォームのリストボックス内に、選択したファイル内の全シートの名前を表示させようとしています。

(3)までは何とか作成することが出来て、動作しています。
(4)で、選択したエクセルファイルのシート名を取得するときに、当該bookを開くことなく、もしくは使用者には選択したbookが立ち上がったことを気づかせずにシート名だけを取得したいと考えていますが、この方法がわかりません。

さらには、取得したシート名から1つを選択し、それを変数に格納して使おうと思っています。

FileSystemObjectというのを使用するのでしょうか？
ExcelVBAをはじめて触るため、手探り状態です。情報が不足している場合はすぐに補足します。
ご存知の方、ご教示よろしくお願いします。

回答No.3

Wendy02 · ベストアンサー

#2の回答者です。

やはり、以下のように、ADO を使ったほうが良いかもしれませんね。

Sub getSheetsName2()
　　'要参照設定：Microsoft ActiveX Data Object 2.x
　　Dim oConn As New ADODB.Connection
　　Dim oRS As New ADODB.Recordset
　　Dim FileName As String
　　Dim shName As String
　　Dim shLists() As String
　　Dim i As Integer
　　FileName = Application.GetOpenFilename("Excel(*.xls),*.xls", 1, "ファイル名取得")
　　If FileName = "False" Then Exit Sub
　　With oConn
　　　　.Provider = "Microsoft.Jet.OLEDB.4.0"
　　　　.Properties("Extended Properties").Value = "Excel 8.0"
　　　　.Open FileName
　　End With

　　Set oRS = oConn.OpenSchema(adSchemaTables)
　　Do Until oRS.EOF
　　　　shName = oRS.Fields("TABLE_NAME").Value
　　　　If Right(shName, 1) = "$" Or Right(shName, 1) = "'" Then
　　　　　　ReDim Preserve shLists(i)
　　　　　　shLists(i) = Mid$(shName, 1, Len(shName) - 1)
　　　　　　i = i + 1
　　　　End If
　　　　oRS.MoveNext
　　Loop
　　oRS.Close
　　Set oRS = Nothing
　　oConn.Close
　　Set oConn = Nothing
　　'確認用
　 'MsgBox Join(shLists, vbCr)
　　With UserForm1
　　　　.ListBox1.List = shLists
　　　　.TextBox1.Text = Mid(FileName, InStrRev(FileName, "\") + 1)
　　End With
End Sub

参考サイト：
ADO を使用して Excel ブックのデータの読み取りおよび書き込みを行う方法 (ExcelADO)
http://support.microsoft.com/kb/278973/ja

私が思っていたことが書かれてありました。

お礼

回答ありがとうございます。
難しくて読み解くのがやっとですが
大変参考になりました。

ADOの方で進めてみようと思います。

回答No.2

Wendy02

こんにちは。

いくつか試してみました。Excelの VBAで、オートメーション・オブジェクトから取り出すというのもやってみましたが、意外に苦戦してしまいました。オートメーション・オブジェクトから取り出す方法は良かったのですが、標準モジュールは、使用不可にすることが出来ても、ローカルモジュールは生きているので、それを、手動計算にしたり、Security 操作し、マクロを動かさないような方法をしてみましたが、コードが大きくなってきてしまいました。

そのまま開いてしまったら、Workbooks_Open()イベントに引っかかることがあるので、結局、ワークブックを開かずにという考え方は、正解ですが、意外に技術が必要ですね。

それで、Excel VBAで、ためしに、DAOで、取り出してみました。古臭い感じがしたのですが、意外によかったので、それを公開します。

'-------------------------------------
'○UserForm には、TextBox1 と　ListBox1 を用意します。
'--------------------------------------
'UserFormモジュール

Private Sub CommandButton1_Click()
　Call getSheetsName
End Sub

'-----------------------------
'標準モジュールに以下を置きます。
'-----------------------------

Sub getSheetsName()
　　Dim DE As Object
　　Dim DB As Object
　　Dim Tb As Object
　　Dim shLists() As String
　　Dim i As Integer
　　Dim buf As String
　　Dim FileName As String

　　'Excel97以上(DAO 3.6 使用）
　　FileName = Application.GetOpenFilename("Excel(*.xls),*.xls", 1, "ファイル名取得")
　　If FileName = "False" Then Exit Sub
　　Set DE = CreateObject("DAO.DBEngine.36")
　　Set DB = DE.Workspaces(0) _
　　.OpenDatabase(FileName, True, True, "Excel 8.0;")
　　For Each Tb In DB.TableDefs
　　　　ReDim Preserve shLists(i)
　　　　If InStr(Tb.Name, "$") = Len(Tb.Name) Then
　　　　　　shLists(i) = Left$(Tb.Name, Len(Tb.Name) - 1)
　　　　　　buf = ""
　　　　End If
　　　　i = i + 1
　　Next
　　DB.Close
　　Set DB = Nothing
　　Set DE = Nothing
'確認用
　　'MsgBox Join(shLists, vbCr)
　　With UserForm1
　　　　.ListBox1.List = shLists
　　　　'ブック名を表示
　　　　.TextBox1.Text = Mid(FileName, InStrRev(FileName, "\") + 1)
　　End With
End Sub

回答No.1

Masa2072

ブックを開かないでシート名を取得することはできないので、ブックを開いた直後に非表示にするというのはいかがでしょうか

C:\Sample.xlsを開きシート名の一覧をイミディエイトウィンドウに出力するマクロのサンプルです。

Sum OutputSheetName()
　Dim Bk As Object
　Dim Sh as Object

　Set Bk = Workbooks("C:\Sample.xls").Open
Windows(1).Visible = False　'開いたブックを非表示にする

　For Each Sh In Bk.Worksheets
　　Denug.Print Sh.Name
　Next

　Bk.Close SaveChanges:=False
End Sub

お礼

早速の回答ありがとうございます。
入力してみたところ、エラーが出てしまったんですが
考え方として、すごく参考になりました。
ありがとうございました。