検索したBOOKが存在しない場合の対処法

質問

たびたびお世話になっております、VBA初心者です。

同じ形式の複数のエクセルBOOKに入っている特定の列の特定の行範囲にあるデータを、
別の集計用エクセルBOOKの単一のシートの中に順々にコピーをしていきたいのです。
集計用BOOKの特定の行には、データBOOKのBOOK名が横にずらっと記載されて
おり、集計用BOOKに組んだVBAでBOOK名を読み取り、そのBOOK名のデータBOOKを
開き、特定セル範囲（A2:A1000）の値をコピーし、集計用BOOKのBOOK名が記載されて
いる列に貼り付けしていく。同様に、集計用BOOKの右どなりの列に記載されている
BOOK名を読み取り、そのBOOKを開き．．．と継続し、集計用BOOKにデータ用BOOK
名が記載されていない列まできたら、Do Whileステートメントを終了する、ということ
をやりたいのです。

＜問題点＞
集計用BOOKに記載のあるデータ用BOOK名のBOOK自体が存在しないものがあるのです。存在しない場合は無視して次に進んで行ってほしいのですが、「ファイルが見つかりません」とメッセージが出て先に進まないのです。IFとTHENを使ってやってみたのですが、IFの中の構文の作り方がよくわからず、なにかうまい方法はありましたら教えて頂きたいのですが。

＜プログラム＞
Sub W()
Dim ファイル名 As String
Dim 列番号 As Long
列番号 = 4
Do While Cells(2, 列番号).Value <> ""
ファイル名 = Cells(2, 列番号).Value
Workbooks.Open "D:\学校\データ\" & ファイル名 & ".xlsx"
Range("A2:A1000").Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
ThisWorkbook.Activate
ActiveSheet.Paste Cells(5, 列番号)
列番号 = 列番号 + 1
Loop
End Sub

よろしくお願いいたします！

回答No.2

High_Score · ベストアンサー

Dir(フルパスファイル名）
ファイルの存在を調べ、あればファイル名（パス無し）を返します。

Sub W()
Dim ファイル名 As String, fpFilename As String
Dim 列番号 As Long

列番号 = 4
Do While Cells(2, 列番号).Value <> ""
ファイル名 = Cells(2, 列番号).Value
fpFilename="D:\学校\データ\" & ファイル名 & ".xlsx"
If Dir(fpFilename)<>""　then

Workbooks.Open fpFilename
Range("A2:A1000").Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
ThisWorkbook.Activate
ActiveSheet.Paste Cells(5, 列番号)

end if

列番号 = 列番号 + 1
Loop
End Sub

質問とは関係ありませんが、ちょっと便利な使い方があります。詳細はググって下さい。

お礼

バッチリ完成させることができました！
ありがとうございます！！

回答No.1

t-aka

Dir関数を使ってみましょう。
一度試してみてください。

↓こんな感じです。
ファイル名 = Cells(2, 列番号).Value
IF Dir(ファイル名)<>"" THEN
　'ファイルが存在するときの処理

ELSE
　'ファイルが存在しないときの処理

END IF

お礼

早速の回答、ありがとうございました！