|
ichinose さん:
回答ありがとうございます。
(当方の返信が遅れてスイマセン)
早速、紹介してもらったコードをトライしたところ
"Split"でのコンパイラーエラー(SubまたはFunctionが定義されていません)が発生しました。これはもしかすると、Excelのバージョンが古い(97)ためでしょうか?
▼ichinose さん:
>▼ベナジザ さん:
>こんばんは。
>
>>
>>保存してあるxlsシート名を把握する方法を教えてください。
>>
>>現在は保存してあるファイル名を把握した後、開きシート名を把握するというコードで処理していますが、より処理を早めるため、”把握したファイルを開く”を実施したくないのです。
>
>ファイルはオープンしていますよ!!
>ただ、Excelがブックとして、開かないだけです。
>
>処理が速いか否かは、試してみてください。
>
>標準モジュールに
>'==========================================================
>Sub test()
> Dim ans As Variant
> Dim nm As Variant
> ans = get_shtnm("D:\My Documents\sample.xls")
>' ↑シート名を取得したいxlsファイルのフルパス
> For Each nm In ans
> MsgBox nm
> Next
>End Sub
>'==========================================================
>Function get_shtnm(ex_path As String) As Variant
> On Error Resume Next
> Dim cnt As Long
> Dim mcnt As Long
> Dim g0 As Long
> Dim g1 As Long
> Dim cat As Object
> Dim tbl As Object
> Set cat = CreateObject("ADOX.Catalog")
> cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=" & ex_path & ";Extended Properties=Excel 8.0"
> ReDim shtnm(1 To cat.Tables.Count)
> g1 = 0
> For Each tbl In cat.Tables
> mcnt = UBound(Split(tbl.Name, "$"))
> cnt = 0
> For g0 = 1 To Len(tbl.Name)
> If Mid(tbl.Name, g0, 1) = "$" Then
> cnt = cnt + 1
> If cnt <> mcnt Then
> shtnm(g1 + 1) = shtnm(g1 + 1) & Mid(tbl.Name, g0, 1)
> End If
> Else
> shtnm(g1 + 1) = shtnm(g1 + 1) & Mid(tbl.Name, g0, 1)
> End If
> Next
> g1 = g1 + 1
> Next
> Set cat = Nothing
> Set tbl = Nothing
> get_shtnm = shtnm()
> Erase shtnm()
> On Error GoTo 0
>End Function
|
|