ファイルが無いときにエラーメッセージを出すようにし

質問

フォルダ内のcsvファイルを[ＣＳＶ貼り付け]というシートに
インポートさせるＶＢＡをつくったんですが、CSVファイルがないときに
エラーメッセージを出すようにしたいのですがどうすればいいでしょうか。

----------------
Sub 読み込み()
Dim Bk As Workbook
Dim Rw As Long, ERw As Long

Const ShName = "ＣＳＶ貼り付け" ' <-- 貼り付け先
PathN = ThisWorkbook.Path & " \ "
Const FNCom = "" ' <-- ファイル名の先頭共通部分指定
Dim FileN As String
Dim Cnt As Integer

FileN = Dir(PathN & FNCom & "*.csv") ' <-- 拡張子を指定 sFileName = Dir(sCurDir & "\*.*", vbNormal)
sCurDir = ThisWorkbook.Path & "\CSVファイル\"
FileN = Dir(sCurDir & FNCom & "*.csv") ' <-- 拡張子を指定

Rw = 1
Application.ScreenUpdating = False

Do Until FileN = ""
Cnt = Cnt + 1
Set Bk = Workbooks.Open(sCurDir & FileN, ReadOnly:=True)

Dim Rws As Long

With ThisWorkbook.Sheets(ShName)
.Cells.Clear
Bk.Sheets(1).Cells.Copy .Range("a1")

End With
FileN = Dir
Loop
Bk.Close SaveChanges:=False

Set Bk = Nothing

Application.ScreenUpdating = True
MsgBox " CSV読みこみ完了しました。", vbInformation

End Sub

回答No.4

MSZ006

＃３です、たびたびすみません。
補足ですが、取り込むCSVファイルが一つだけと決まっている場合は、下記のようなコードでも行けます。
「CSV貼り付け」というシートに取り込みます。

-------------
Sub test()
Dim Bk As Workbook
Dim PathN As String
Dim FileN As String
Dim SheetN As String

PathN = ThisWorkbook.Path & "\CSVファイル\" ' <-- ＣＳＶファイルの入っているフォルダ
SheetN = "CSV貼り付け" <-- 貼り付け先のシート名（あらかじめこの名前のシートを作っておく）
FileN = Dir(PathN & "*.csv") ' <-- ＣＳＶファイル名取得

Application.ScreenUpdating = False

If FileN = "" Then
MsgBox "CSVファイルがありません。"
Exit Sub
End If

Set Bk = Workbooks.Open(PathN & FileN, ReadOnly:=True)
Bk.Sheets(1).Cells.Copy ThisWorkbook.Sheets(SheetN).Range("a1")
Bk.Close SaveChanges:=False

Application.ScreenUpdating = True
MsgBox " CSV読み込み完了しました。"

End Sub

回答No.3

MSZ006

＃２です。

不要なコードですが、たくさんありますよ^^;)
また、Do-Loopで廻していますが、CSVファイルが複数存在した場合に、最後に開いたファイルだけがコピーされ、前のは消されてしまいます。これでは何のためにループを廻しているのか意味がありません。

私でしたら下記のようにします。
「CSVファイル名」のシートを追加していき、そこにファイルの内容を取り込みます。複数のCSVファイルの場合もすべて取り込みます。
-------------------

Sub test()
Dim Bk As Workbook
Dim PathN As String
Dim FileN As String
Dim SheetN As String

PathN = ThisWorkbook.Path & "\CSVファイル\" ' <-- ＣＳＶファイルの入っているフォルダ
FileN = Dir(PathN & "*.csv") ' <-- ＣＳＶファイル名取得

Application.ScreenUpdating = False

If FileN = "" Then
MsgBox "CSVファイルがありません。"
Exit Sub
End If

Do Until FileN = ""
Set Bk = Workbooks.Open(PathN & FileN, ReadOnly:=True)
SheetN = Left(FileN, Len(FileN) - 4)
ThisWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = SheetN

Bk.Sheets(1).Cells.Copy ThisWorkbook.Sheets(SheetN).Range("a1")

Bk.Close SaveChanges:=False
FileN = Dir
Loop

Set Bk = Nothing

Application.ScreenUpdating = True
MsgBox " CSV読み込み完了しました。"

End Sub

回答No.2

MSZ006

CSVファイルが一つもない時にエラーメッセージを表示、でしょうか？

Doの前に、

If FileN = "" Then
MsgBox "CSVファイルがありません"
Exit Sub
End If

を入れればよいかと思います。

なお、よくよくみると何の意味があるのか分からないようなコーディングが見受けられますが・・・。

お礼

うまくできました！
ネットにおちていた、コードを改造してつくったものです。
フォルダ内のCSVを
ＣＳＶ貼り付けのシートに書き込みたいだけなんですが、なにか
不要なコードってありますか？
よろしければ教えて頂けないでしょうか

回答No.1

saestick

On Error Resume Next
をエラーが出る個所の前に設置するば出ないと思います。
処理が短くエラーが限られている場合ならを入れておけば問題ないと思います。

これ以降エラーが出ても致命的でない限り飛ばすので
処理が長くなりほかのエラーも考えられるようでしたらあまりお勧めできません。

参考URL：

http://officetanaka.net/excel/vba/tips/tips104.htm