VBA 探しているFileがないときの処理方法
現在、下記のようにしてマクロ実行ブックと同じ階層のフォルダ名を取得してAに、フォルダ内のabc.XLSのC9の値をBに、abc.XLSの更新日時をCに表示させています。
このとき、フォルダ内にabc.XLSが無い場合にファイル名をAに書き出してB及びCは空白というように表示したいのですが、どのようにすればよろしいでしょうか。
macro1は以前質問させて頂いたものがベースになっています。ExecuteExcel4Macroを使っている関係でファイル名が無いときの処理はDirを使ってできるとmougで調べてわかりましたが、自分の知識ではできず、macro2を作成したのですが、指定ファイルがない場合の処理がうまくできずにいます。
macro1はファイルオープンの窓が開きます。macro2はファイルが存在しないという窓が開きます。
どちらの場合でもかまいませんのでお力をお貸し頂けませんでしょうか。
Sub macro1()
Dim myPath As String
Dim myFolder As String
Dim r As Long
r = 3
myPath = ThisWorkbook.Path & "\"
myFolder = Dir(myPath, vbDirectory)
myBook = "abc.XLS"
Application.ScreenUpdating = False
Range("A3:C60").Clear
Do Until myFolder = ""
If myFolder <> "." And myFolder <> ".." Then
If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then
Cells(r, 1) = myFolder
Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[" & myBook & "]Sheet1 '!R9C3")
On Error Resume Next
Cells(r, 3) = FileDateTime(myPath & myFolder & "\" & myBook)
On Error GoTo 0
If Cells(r, 3) = "" Then
Cells(r, 2) = "myBook"
End If
Cells(r, 2).NumberFormatLocal = "#,##0_ "
Cells(r, 3).NumberFormatLocal = "y""年""m""月"""
With Range("A3:C60")
.Sort Key1:=Range("C3"), Order1:=xlAscending
.Borders.LineStyle = True
End With
r = r + 1
End If
End If
myFolder = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Sub Macro2()
Dim myPath As String
Dim myFolder As String
Dim myBook As String
myPath = ThisWorkbook.Path & "\"
myFolder = Dir(myPath, vbDirectory)
myBook = "abc.XLS"
i = 2
Do Until myFolder = ""
If myFolder <> "." And myFolder <> ".." Then
If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then
Workbooks.Open (myPath & myFolder & "\" & myBook)
Range("C9").Activate
Selection.Copy
ThisWorkbook.Activate
Cells(i, 1) = myFolder
Cells(i, 2).PasteSpecial xlValues
Cells(i, 3) = FileDateTime(myPath & myFolder & "\" & myBook)
Workbooks(myBook).Close SaveChanges:=False
i = i + 1
End If
End If
myFolder = Dir()
Loop
End Sub
お礼
こういうのが知りたかったんです！ありがとうございました。