FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

Excelシート名を得る 


質問者さんには不評だったものもありますが・・・・ (広告表示も間近なので)

CreateObject("Excel.Application") してからファイルをオープンして・・・
って例題もいっぱいあるし・・・似たようなものも過去記事にあるし・・・で

不慣れな以下2つを記述しておこうかと・・・・

・GetObject を使って
・ADODB の OpenSchema を使って

なお、これらの方法は Runtime 環境でもいけると思います。

ただし難点が・・・ 確認した環境は、Vista+2007 なのですが、
OpenSchema でやった場合、確認していた拡張子が xlsm ファイルでしたけど・・・
Excel ファイルの更新日時が変わっちゃうんですね・・・実行した時刻に・・・・
Excel ファイルの更新日時を見ながら何かしている状況では使えないかな?
他の拡張子ではどうなるんだろう??

ただね・・・ OpenSchema の方が速いんだよね・・・ GetObject より・・・
また、何らかのエラーがあっても Excel がゾンビっぽくならないし・・・
 
・GetObject を使って

関数を作ってみました
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 & "\aaaa.xlsm")
  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

 
上記記述の中で
    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
この部分での、Visible 判別は以下のようにしても良いみたいですね
    If (Not oBook.Windows(1).Visible) Then
とか
    If (Not oApp.Windows(oBook.Name).Visible) Then


う~ん。いろんなところから・・・色々辿れますね・・・ どれが良いのだろうか・・・?


・ADODB の OpenSchema を使って

不評そうだった OpenSchema を使ったものになります
関数名はチョッと変えていますが、使い方は一緒です。

Public Function GetExcelSheet2(sPath As String) As Variant
  Dim cn As New ADODB.Connection
  Dim rs As ADODB.Recordset
  Dim vA() As Variant
  Dim i As Long

  On Error Resume Next
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
      & "Data Source=" & sPath & ";" _
      & "Extended Properties='Excel 12.0'"

  i = 0
  Set rs = cn.OpenSchema(adSchemaTables)
  While (Not rs.EOF)
    ReDim Preserve vA(i)
    vA(i) = Left(rs("TABLE_NAME"), Len(rs("TABLE_NAME")) - 1)
    i = i + 1
    rs.MoveNext
  Wend
  rs.Close
  Set rs = Nothing
  cn.Close

  GetExcelSheet2 = vA
  If (Err <> 0) Then GetExcelSheet2 = Err.Number
End Function

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

  v = GetExcelSheet2(CurrentProject.Path & "\aaaa.xlsm")
  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

 
rs("TABLE_NAME") では、シート名 + $ の文字列が得られるので、
$ を判別せずに、$ を除いた左から切り出す・・・ に特化してみました。

冒頭でも言っていましたが、この方法では、確認していた拡張子が xlsm ファイルでしたけど・・・
Excel ファイルの更新日時が変わっちゃうんですね・・・実行した時刻に・・・・
Excel ファイルの更新日時を見ながら何かしている状況では使えないかな?
他の拡張子ではどうなるんだろう??

上記は Vista+2007 で確認した時の内容になってます。

2000 / 2003 であれば以下2か所、必要に応じて変更すれば良さそうです
Microsoft.ACE.OLEDB.12.0 → Microsoft.Jet.OLEDB.4.0
Excel 12.0 → Excel 8.0


【追記】3/7
以下部分を
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
      & "Data Source=" & sPath & ";" _
      & "Extended Properties='Excel 12.0'"
以下に変更すると、更新日時は変わらない様です
  cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
      & "DBQ=" & sPath & ";ReadOnly=1;"


・とは言っても CreateObject を使ってみる

GetObject で得られたその環境は、どうなっているんだろうか・・・
こんな面倒な処理を考えなくてすむ分、楽な方法なんですが・・・
Runtime では、CreateObject は使えないそうですね・・・

何故楽か・・・
現状 Excel を使っていようがいまいが、新しい Excel を起動して、
そこには指定したファイルのみを読み込んで・・・
用が済んだら、ファイルを閉じて、Excel を終了して・・・
自分がやっただけの足跡を拭ってくるだけ・・・
雰囲気、以下の様な記述になるんでしょうか・・・

Public Function GetExcelSheet3(sPath As String) As Variant
  Dim vA() As Variant, v As Variant
  Dim i As Long

  On Error Resume Next
  i = 0
  With CreateObject("Excel.Application")
    With .Workbooks.Open(sPath, ReadOnly:=True)
      For Each v In .WorkSheets
        ReDim Preserve vA(i)
        vA(i) = v.Name
        i = i + 1
      Next
      .Close SaveChanges:=False
    End With
    .Quit
  End With
  GetExcelSheet3 = vA
  If (Err <> 0) Then GetExcelSheet3 = Err.Number
End Function

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

  v = GetExcelSheet3(CurrentProject.Path & "\aaaa.xlsm")
  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

 

※ エラーの処理は端折っていますが・・・ 使えなくはない・・・ かな?

今回、サンプルファイルはありません。
関連記事

2014/10/26

Category: 関数を作ってみる

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。