色の知識で人生の可能性が広がる!みんなに役立つ色彩検定 >>

お世話になります。

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

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

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

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

教えて!goo グレード

A 回答 (7件)

Access VBAよりExcelのシート名を取得


http://oshiete.goo.ne.jp/qa/8772873.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 オプション付きで起動した中での確認なので?)
    • good
    • 1
この回答へのお礼

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

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

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


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

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

お礼日時:2014/10/22 19:43

たびたび、すみません。

うっかりが・・・。

もう一つ、

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

の、

Right$(strFile1, 3)

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

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





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

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

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

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

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

お礼日時:2014/10/22 19:49

Shell(strFile2 & strFile3, vbHide)



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

うっかりしていました。

起動していない場合はエラーが・・・。

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

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

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

この中の一部を使って、

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を使っています。引数は
いろいろあるので確認してみてください。
    • good
    • 0

すみません。

参照先がはずれていました。以下です。
http://support2.microsoft.com/default.aspx?scid= …
    • good
    • 0

No1です。

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

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
    • good
    • 0
この回答へのお礼

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

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

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

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

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

お礼日時:2014/10/21 19:00

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

関連するカテゴリからQ&Aを探す


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング