Access VBAよりシート名を取得したい

質問

お世話になります。

現在、Accessにてツールを作成しておりますが、VBAより
特定のパスにあるExcelファイルのシート名を取得する必要が
あります。
※当該ツールはRuntime環境にて利用するため、CreateObject
　が利用できません。

取得はDAO.Tabledefs を使って取得できましたが、GetObjectを
使って取得する方法をご教授頂けると幸いです。

シート名を取得するExcelファイルが、　C:\test\テスト.xlsxの場合
どのような記述になりますでしょうか。

勉強不足で大変恐縮ですが、ご教授のほど宜しくお願い致します。

回答No.7

30246kiku · ベストアンサー

Access VBAよりExcelのシート名を取得
http://okwave.jp/qa/q8772873.html

ここでの OpenSchema を使用したものは不評だったでしょうか

というのは置いといて

関数を用意しました
いろんなパターンでテストはしていないので・・・
（完成形ではないので不具合等は修正してください）

GetExcelSheet に、Excelファイルのフルパスを与えると
シート名の配列が Variant で得られます。
内部でエラーがあったら、最後のエラー番号を返します。

内部の動きとして、GetObject で対象の Excel ファイルを開きます。
GetObject で初めて開かれた場合、そのファイルの Visible は False
False なら後始末としてそのファイルを閉じ、
結果 Excel で開いているファイルが無ければ、Excel を終了します。
つまり、既に開いていたものについては閉じる事はしません。

この関数の使い方は、後半の Samp1 を例としてください。

Public Function GetExcelSheet(sPath As String) As Variant
　　Dim oApp As Object, oBook As Object
　　Dim vA() As Variant, v As Variant
　　Dim i As Long

　　On Error Resume Next
　　i = 0
　　Set oBook = GetObject(sPath)
　　If (Not oBook Is Nothing) Then
　　　　For Each v In oBook.Worksheets
　　　　　　ReDim Preserve vA(i)
　　　　　　vA(i) = v.Name
　　　　　　i = i + 1
　　　　Next
　　　　Set oApp = oBook.Application
　　　　For Each v In oApp.Windows
　　　　　　If (v.Caption = oBook.Name) Then
　　　　　　　　If (Not v.Visible) Then
　　　　　　　　　　oBook.Close SaveChanges:=False
　　　　　　　　End If
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　Set oBook = Nothing
　　　　If (oApp.Workbooks.Count = 0) Then oApp.Quit
　　　　Set oApp = Nothing
　　End If
　　GetExcelSheet = vA
　　If (Err <> 0) Then GetExcelSheet = Err.Number
End Function

Public Sub Samp1()
　　Dim v As Variant
　　Dim sS As String
　　Dim i As Long

'　　v = GetExcelSheet(CurrentProject.Path & "\test.xlsm")
　　v = GetExcelSheet("C:\test\テスト.xlsx")
　　If (IsArray(v)) Then
　　　　sS = "> シート数 = " & UBound(v) + 1 & vbCrLf
　　　　For i = 0 To UBound(v)
　　　　　　sS = sS & v(i) & vbCrLf
　　　　Next
　　　　MsgBox sS
　　End If
End Sub

余談）

piroin654 さんのは

>　　With appObj
>　　　　For Each appObj In .Sheets

部分の、For Each 用の変数を変更すれば良いと思います。
また、Shell で起動しておくことは不要と思います。
（/Runtime オプション付きで起動した中での確認なので？）

お礼

30246kiku様
いつもご回答ありがとうございます。

教えて頂いた方法でうまくいきました。
GetExcelSheet　ありがとうございます！今回に限らず使わせて
いただきます！

というか、そのままコピーしただけです。。
内容はまだ理解しておりません。

当該ツールは、ご回答頂いていた「抽出結果をExcelへ出力」
と同じもので、出力前に該当のシートが存在するか否かのチェックを
行う為、シート名の取得が必要となりました。

大変助かりました。ありがとうございました。

回答No.6

piroin654

たびたび、すみません。うっかりが・・・。

もう一つ、

If StrComp(Right$(strFile1, 3), "xlsx", 1) = 0 Then

の、

Right$(strFile1, 3)

で、3を4にしてください。つまり、

If StrComp(Right$(strFile1, 4), "xlsx", 1) = 0 Then

回答には、ファイルが既に起動されている場合のエラー処理を
していません。必要ですかね。探せます？

お礼

piroin654様
度々のご回答ありがとうございます。

本来であれば、ご回答頂いた内容をちゃんと理解しつつ
作り込まなければならないのですが。。なかなか時間をとれず
結局教えて頂いたものをコピペし若干加工する程度です。

30246kiku様の方で関数を作って頂いたので、今回は
こちらを採用させて頂きたいと思います。

いつもご回答頂き感謝です。

回答No.5

piroin654

Shell(strFile2 & strFile3, vbHide)

のvbHideはプロセスが残るので、vbNormalFocusか、
vbNormalNoFocusにしてファイルを見えるように
しておいたほうがいいかもしれません。

回答No.4

piroin654

うっかりしていました。起動していない場合はエラーが・・・。

やはり、Shellを用いてファイルを起動しておかないと
いけないですね。
方法はいろいろあるのですが、環境によってエラーが
でるかもしれませんが。わかりやすいところで以下のような
方法があります。

http://hanatyan.sakura.ne.jp/vbhlp/tap_kanren.htm

(やっていることは、No3の以下と同じですが。)
http://support2.microsoft.com/default.aspx?scid=kb%3Ben-us%3B296586

この中の一部を使って、

Sub test()
　　Dim strFile1 As String
　　Dim strFile2 As String
　　Dim strFile3 As String
　　Dim ret As Long
　　Dim appObj As Object
　　strFile1 = "C:\test\テスト.xlsx"

　　If StrComp(Right$(strFile1, 3), "xlsx", 1) = 0 Then
　　　　strFile2 = "C:\Program Files\Microsoft Office\Office\Excel.exe "
　　　　strFile3 = Chr$(34) & strFile1 & Chr$(34)
　　　　ret = Shell(strFile2 & strFile3, vbHide)
　　End If

　　Set appObj = GetObject(strFile1)
　　With appObj
　　　　For Each appObj In .Sheets
　　　　　　MsgBox appObj.Name
　　Next
　　End With

　　Set appObj = Nothing
End Sub

なお、Shellの引数で、vbHideを使っています。引数は
いろいろあるので確認してみてください。

回答No.3

piroin654

すみません。参照先がはずれていました。以下です。
http://support2.microsoft.com/default.aspx?scid=kb%3Ben-us%3B296586

回答No.2

piroin654

No1です。ランタイム環境がないので確認はしていませんが、ランタイムでの
実行については、以下の　Run-Time Version of Microsoft Access
にあります。これはレポートを開く方法ですが、接続方法については
Shellを使ってExcelに接続することになると思われます。

回答No.1

piroin654

GetObjectを使ってならば、普通には、

Sub test()
　　Dim appObj As Object
　　Dim strFile As String

　　strFile = "C:\test\テスト.xlsx"
　　Set appObj = GetObject(strFile)

　　With appObj
　　　　For Each appObj In .Sheets
　　　　　　MsgBox appObj
　　　　Next
　　End With

　　Set appObj = Nothing
End Sub

お礼

piroin654さま
いつもご回答ありがとうございます。

教えて頂いた内容のファイルのパスの箇所を修正しました。

path = CurrentProject.path
strFile = path & "\テスト.xlsx"

実行してみたところ、
＞MsgBox appObj
の箇所で、「実行時エラー438　オブジェクトは、このプロパティまたは
メソッドをサポートしていません。」とのエラーが表示されました。

どのようなことが考えられますでしょうか。
度々申し訳ございませんが、宜しくお願い致します。