[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイルの存在を調べて、なかったファイルをスキップしたいです』（レモ）
こんにちは。連日の質問失礼します。
よろしくお願いいたします。
内容といたしましては、
フォルダ内のファイルから特定のデータを抜き出し、
其々に転記する場所を設定して計算する
といったマクロを作成中です。
元々はコピー元のブックが存在するか確認した後
すぐ処理(ファイルを開いて指定の場所にコピペ)を行うという事を繰り返すシステムで、
何とか完成までこぎつけたのですが、
そのままだと処理が重い&ファイルが存在しなかった場合に
止まってしまいやり直し…という場面が非常に多かったので、
最初の段階でファイルが存在するかどうかを確認する形に変更したいと考えています。
できれば、存在しなかったファイルをとばすor指定の値を代入する処理ができると尚嬉しいです。
ただ、その方法に変更しようとした際のやり方が良くないのか、
エラーが出て止まってしまう形になってしまいました。
どうすれば事前に確認することが出来るでしょうか。
ご教示いただけますと幸いです。
よろしくお願いいたします。
初めてマクロを触っているので、基礎的な部分のミスが多いかもしれません。
申し訳ございません。
コードは以下の通りです。
Option Explicit
Sub Y列にデータを取得_Click()
'列を追加します
Columns(25).Insert
Dim FilePath As String Dim FileName As String Dim wb As Workbook Dim F_pass As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
F_pass = .SelectedItems(1)
End With
FilePath = F_pass
'コピー元のブックが存在するか確認
If Dir(FilePath & "\" & "月報A.csv") = "" Then
'既に開いていたらメッセージを表示してSubを抜ける
MsgBox "月報A.csv" & "というファイルが存在しません"
Exit Sub
End If
'コピー元のブックが存在するか確認
If Dir(FilePath & "\" & "月報B.csv") = "" Then
'既に開いていたらメッセージを表示してSubを抜ける
MsgBox "月報B.csv" & "というファイルが存在しません"
Exit Sub
End If
'コピー元のブックを開く
Workbooks.Open FilePath & "\月報A.csv"
'データをコピー
Workbooks("月報A").Worksheets(1).Cells(4, 9).Copy _
Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(4, 25)
'コピー元のブックを閉じる(セーブしない)
Workbooks("月報A").Close savechanges:=False
'コピー元のブックを開く
Workbooks.Open FilePath & "\月報B.csv"
'データをコピー
Workbooks("月報B").Worksheets(1).Cells(4, 9).Copy _
Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(5, 25)
'コピー元のブックを閉じる(セーブしない)
Workbooks("月報B").Close savechanges:=False
End Sub
(月報A、Bともに、もともとは先にFileNameで定義していたのですが一度外して直接書き込んでいます)
このままでは、エラー番号9「インデックスが有効範囲にありません」で止まってしまいます。
どこでエラーが出ているのかわからない状態です。
動いた方のコードが必要であればお申し付けください。
お忙しいところ恐縮ですが、ご教示いただけますと幸いです。
よろしくお願いいたします。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
データが本当に存在するかどうかは、改変前のプログラムで同じ名前のフォルダーを使用したときに
きちんと動いたので存在していると思います。
（レモ） 2021/09/16(木) 11:21
■１
↓これは思っている通りの処理ですか？必要性が今一つピンとこないですが・・・
'列を追加します Columns(25).Insert
■２
↓どのような意図がありますか？「F_pass」をそのまま使えば済むのではありませんか？
FilePath = F_pass
■３
↓やっていることとコメントが合っていません
'既に開いていたらメッセージを表示してSubを抜ける
■４
＞どこでエラーが出ているのかわからない状態です。
黄色くハイライトされている行が【実行しようとしている】行です。
したがって、エラーが出て止まっている場合、そのハイライトされているところが（エラーで）実行できないということです。
Workbooks("月報A").Worksheets(1).Cells(4, 9).Copy Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(4, 25)
なので、例えば↑がハイライトされて、「インデックスが有効範囲にありません」となっているなら、
・"月報A"という名前のブックが開かれていない
・Workbooks("月報A").Worksheets(1) が存在しない
・Workbooks("月報A").Worksheets(1).Cells(4, 9) が存在しない
・Workbooks(ThisWorkbook.Name) が存在しない
・Workbooks(ThisWorkbook.Name).Worksheets(1) が存在しない
・Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(4, 25) が存在しない
などが考えられますが、１番目以外は存在しないことが考えられません。
したがって、消去法で「Workbooks("月報A.csv")」とすべきところを「Workbooks("月報A")」としたことが原因ではないかと推測しますが、いかがでしょうか？
↓のように仰っているのでそれは確認済だということなのかもしれませんが・・・
＞追伸：こちらの書き込みですと途中から拡張子を書き忘れている形になっていますが、
＞元のデータでは拡張子まで書き込まれたうえでこのエラーが出ています。
■５
ちなみに、結局のところ
(1)指定したフォルダにある (2)すべてのＣＳＶファイルを適宜、ブックとして開いて (3)I4セルに相当する部分の値を 自ブックのY列4行目以降に順番に書き出す
といったことなら、このような感じでよいとおもいます。
Sub さんぷる1()
Dim フォルダパス As String
Dim ファイル名 As String
Dim 出力行 As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then フォルダパス = .SelectedItems(1)
End With
Stop 'ブレークポイントの代わり
If フォルダパス = "" Then
MsgBox "フォルダが選択されなかったので処理しません"
Exit Sub
End If
出力行 = 4
ファイル名 = Dir(フォルダパス & "\" & "*.csv")
Do Until ファイル名 = ""
With Workbooks.Open(フォルダパス & "\" & ファイル名)
ThisWorkbook.Worksheets(1).Cells(出力行, "Y").Value = .Worksheets(1).Range("I4").Value
ThisWorkbook.Worksheets(1).Cells(出力行, "X").Value = .Name
出力行 = 出力行 + 1
.Close savechanges:=False
End With
ファイル名 = Dir()
Loop
End Sub
■６
また、そうではなくて
(1)指定したフォルダにある (2)【特定の】ＣＳＶファイルを【決まった順番で】、ブックとして開いて (3)I4セルに相当する部分の値を 自ブックのY列4行目以降に順番に書き出す
のようなことならこうですね。
Sub さんぷる2()
Dim フォルダパス As String
Dim ファイル名 As Variant
Dim 出力行 As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then フォルダパス = .SelectedItems(1)
End With
Stop 'ブレークポイントの代わり
If フォルダパス = "" Then
MsgBox "フォルダが選択されなかったので処理しません"
Exit Sub
End If
出力行 = 4
For Each ファイル名 In Array("月報A", "月報B")
If Dir(フォルダパス & "\" & ファイル名) <> "" Then
With Workbooks.Open(フォルダパス & "\" & ファイル名)
ThisWorkbook.Worksheets(1).Cells(出力行, "Y").Value = .Worksheets(1).Range("I4").Value
ThisWorkbook.Worksheets(1).Cells(出力行, "X").Value = .Name
出力行 = 出力行 + 1
.Close savechanges:=False
End With
End If
Next ファイル名
End Sub
いずれにせよ、繰り返しになりますが、思った通りに動かないということがあればステップ実行してちゃんと自己検証することが解決の近道だとおもいますので、一度トライしてみてはどうでしょうか？
（といいつつ、私が提示したコードはテストしてないのでミスっているかもですが・・・）
（もこな２ ） 2021/09/16(木) 13:41
× With Workbooks.Open(フォルダパス & "\" & ファイル名) ○ With Workbooks.Open(フォルダパス & "\" & ファイル名 & ".csv")
ですね。失礼しました。
（もこな２ ） 2021/09/16(木) 13:43
仰る通り、ステップ実行が出来ていませんでした。
教えてくださってありがとうございます。
最後の方、月報Bが上手くコピペできていない様でした。
(様でした、というのも、私がよくわかっておらず、、申し訳ありません。)
頂いた気になる点について、回答いたします。
■1 列追加の処理について
以前までのデータを後ろに押し出しつつ、新しいデータを新しい列に
流し込む処理にしたかったので、入力用の列を毎回追加するようにしました。
■2 仰る通りです。訂正します。
意図としては、大変ものぐさで、、
FilePathが基になったコードで使われていた変数だったのですが、
後ろのコードをあまり変えない＋新しく追加したF_pass = .SelectedItems(1)を
使いたくてこのような形にしてしまいました。
■3 仰る通りです。
「存在しなければ」というような表現が正しいと思うので、訂正します。
■4 通しで実行するとハイライトが出なかったので、分からなくなってしまったようです。
お教えいただいたステップ実行を試し、一番上に書いたような結果になりました。
データの拡張子については、いただいている通り確認済となっています。
考えて頂いた原因について、今後他の事で同じエラーが出た時、
切り分けとして活用させていただきたく思います。ありがとうございます。
また、私が考えていた仕組みは頂いた中の■6に該当します。
サンプルコード、２つもいただいて大変感謝しております。
実行してみます。
ありがとうございます。
頂いたコードを実行させていただくのにお時間いただくかと思いますが、
結果出次第お伝えできましたらと思います。
ステップ実行を積極的にしつつ、今後も進めていきます。
大変助かりました。ありがとうございます。
（レモ） 2021/09/16(木) 14:45
お世話になっております。
無事稼働させることが出来ました！
ご教示いただいて、ありがとうございます。
いただいたコードを少しだけ、希望の動きになるように編集して
そちらもうまくいったのでご連絡差し上げます。
いただいたコードの状態では、
A B 大阪 100 奈良 200 兵庫 300 京都 400 滋賀 500 というデータで、京都のファイルがないとき、
A B 大阪 100 奈良 200 兵庫 300 京都 500 滋賀 となるので、ファイルがない時用のIf文を追加しました。
出力行 = 4
For Each ファイル名 In Array("月報A","月報B","月報C"…)
If Dir(フォルダパス & "\" & ファイル名 & ".csv") <> "" Then
With Workbooks.Open(フォルダパス & "\" & ファイル名 & ".csv")
ThisWorkbook.Worksheets(1).Cells(出力行, "Y").Value = .Worksheets(1).Range("I4").Value
出力行 = 出力行 + 1
.Close savechanges:=False
End With
'ファイルがなかったときの処理を追加
End If
If Dir(フォルダパス & "\" & ファイル名 & ".csv") = "" Then
With ThisWorkbook.Worksheets(1).Cells(出力行, "Y").Value = "0"
出力行 = 出力行 + 1
End With
End If
Next ファイル名
このような形になりました。これで、京都は空欄になりました。
(本当は文字を入れたかったのですが、なぜか空欄に…今回は問題ないと思いそのままにしています)
今後誰かがこちらを参照される際に参考になればと思います。
失礼なことをしてしまっていたら申し訳ありません。
何度も繰り返しですが、丁寧なご返信と添削をいただきまして、ありがとうございます。
頂いたアドバイスを基に、今後も勉強していきたいと思います。
本当にありがとうございました。
（レモ） 2021/09/16(木) 19:28
If Dir(フォルダパス & "\" & ファイル名 & ".csv") = "" Then
よって、Else節の処理を追加して、Ifの結果にかかわらず出力行が+1されればよいのではありませんか？
Sub さんぷる2_改()
Dim フォルダパス As String
Dim ファイル名 As Variant
Dim 出力行 As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then フォルダパス = .SelectedItems(1)
End With
Stop 'ブレークポイントの代わり
If フォルダパス = "" Then
MsgBox "フォルダが選択されなかったので処理しません"
Exit Sub
End If
出力行 = 4
For Each ファイル名 In Array("月報A", "月報B")
If Dir(フォルダパス & "\" & ファイル名) <> "" Then
With Workbooks.Open(フォルダパス & "\" & ファイル名)
ThisWorkbook.Worksheets(1).Cells(出力行, "Y").Value = .Worksheets(1).Range("I4").Value
.Close savechanges:=False
End With
Else
ThisWorkbook.Worksheets(1).Cells(出力行, "Y").Value = "ファイル無し"
End If
出力行 = 出力行 + 1
Next ファイル名
End Sub
（もこな２ ） 2021/09/16(木) 20:30
色々な解決法だったり、もっといいやり方というものが沢山あって面白いですね。
ご指導いただきありがとうございます。
（レモ） 2021/09/17(金) 08:52
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.