質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

479閲覧

フォルダ及びサブフォルダから

motohiro

総合スコア9

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2018/06/22 08:33

前提・実現したいこと

エクセル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/ツールのバージョンなど)

ここにより詳細な情報を記載してください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

m.ts10806

2018/06/22 08:36

プログラムコード(およびエラーメッセージ)は質問内容としては最も重要な部分であるため、見やすくしていただけると助かります。<code>ボタン押下→「コード」部分にコードを貼り付け→「ここに言語を入力」に対象言語名記入(エラーメッセージの場合は不要)の手順で「コードハイライト化」してください。(質問編集画面ではリアルタイムでプレビューが表示されるので見ながら調整してください)
m.ts10806

2018/06/22 08:37

dpath に入っているファイル名は確かですか?存在するファイルを指定していますか?ブレイクポイントを貼ってどこまで想定通りに進んでいるかデバッグをしてみてください。
motohiro

2018/06/22 08:40

ありがとうございます 質問内容を見やすくして再度、質問を行います
m.ts10806

2018/06/22 08:41

いえ、質問は編集できるので、編集してください。
guest

回答1

0

ベストアンサー

以下のように対象ファイルをエクセルに限定してはどうでしょうか。

'ファイル一覧の取得
buf = Dir(dpath & ".xls")

<追記>
上記に加え、Do Loop に入った直後、以下のIf文を追加し、
「~$excelファイル名.xls*」を開かないようにすれば良いと思います。

'ファイルの数だけループ
Do While buf <> ""
If Left(buf,2)<>"~$" then
(この中に処理を入れる)
End If
Loop

投稿2018/06/22 15:16

編集2018/06/24 07:42
TanakaHiroaki

総合スコア1063

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yamashita_yuich

2018/06/24 06:16

質問者様がプログラムを実行したフォルダの中身がわかっていないのですが、可能性として、「desktop.ini」ファイルがあった可能性と「~$excelファイル名.xls」系の一時ファイルが残っている可能性を感じました。(恐らくexcelファイルの絞り込みをしていないということはExcelファイルしか入っていない想定なのだろう)そうすると、~$ファイルも処理をスキップできるように正規表現パターンを使用した方がいいと感じました。(もしくは使い捨てプログラムなのであれば非表示ファイルを全て表示して不要なファイルを削除する)
TanakaHiroaki

2018/06/24 07:29

baseballyamaさま さすがですね。 確かに「~$excelファイル名.xls」のために想定外の動作をした経験があります。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問