| |
▼ベナジザ さん：
こんばんは。
>
>保存してある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
|
|
ichinose
- 07/6/30(土) 22:27 -
