前提・実現したいこと
エクセル2013
フォルダ及びサブフォルダからエクセルファイルのデータ抜出の実装中に以下のエラーメッセージが発生しました。
発生している問題・エラーメッセージ
Openメソットは失敗しました
該当のソースコード
Option Explicit
Sub main()
Call test("")
End Sub
Function test(path As String)
'型宣言
Dim buf As String
Dim cnt As Long
Dim dpath As String
Dim tbook As Workbook
Dim lbook As Object
Dim hit As Object
Dim word As String
Dim f As Object
'準備
Set lbook = ThisWorkbook.ActiveSheet
cnt = 2 '開始行の設定
'抽出先のリストを削除
'lbook.Range(cnt & ":" & Rows.Count).ClearContents
'フォルダ選択ダイアログ
If path = "" Then
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then dpath = .SelectedItems(1) & "\" End If End With
Else
'サブフォルダが指定されている場合
dpath = path
End If
If dpath = "" Then Exit Function
'ファイル一覧の取得
buf = Dir(dpath & ".")
'ファイルの数だけループ
Do While buf <> ""
Set tbook = Workbooks.Open(Filename:=dpath & buf, ReadOnly:=True) 'ブックを開く
With tbook.ActiveSheet
'Worksheets ("sheet1")
lbook.Range("A" & cnt).Value = .Range("G7").Value '建物名
End With
tbook.Close 'ブックを閉じる
buf = Dir()
cnt = cnt + 1 'カウントアップ
Loop
With CreateObject("Scripting.FileSystemObject")
For Each f In .GetFolder(dpath).SubFolders
Call test(f.path)
Next f
End With
End Function
試したこと
指定したフォルダ及びサブフォルダ中からエクセルファイルから
指定したシートのセルからデータ抜き出したいデータ一覧表を作成したい
補足情報(FW/ツールのバージョンなど)
ここにより詳細な情報を記載してください。
回答1件
あなたの回答
tips
プレビュー