Excel VBAファイルがない場合メッセージ表示

質問

ExcelVBAでプログラムを実行させたときに2つのファイルを参照します。

　(1)結果コピー先ファイル
　(2)データ元ファイル

この2つのファイルのうち、いずれかがなかった場合にメッセージを表示させたいのですが思うように表示されません。

以下のように動作させたいのですがうまくいきません。

　(1)2種類のファイルがないときには両方のメッセージを
　　1つの画面に表示したい。
　(2)どちらか一方のファイルがないときには、
　　エラーメッセージを表示させエラーのないファイルを
　　表示させない。
　　　※いろいろ試したら(a)がないメッセージが表示されたが、
　　　　(b)のファイルが表示された。
　(3)正常に処理が終了した場合は、完了メッセージを表示したい。

途中まで書いてみたコードは以下の通りです。
　※実行コードは中略します。

'//////////////////////////////////////////////////////

Sub test1()

Dim sMsg As String
Dim sMyDir As String
sMyDir = ThisWorkbook.Path & "\"
Dim Ws As Worksheet
Dim vTgYear As Variant
Dim Wb As Workbook
Set Wb = Workbooks("算出プログラム.xls")
Set Ws = Wb.Sheets("入力内容")
vTgYear = Ws.Range("D17").Value

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Dim sWbkName As String, StName As String
Dim wbk結果1 As Variant
sWbkName = "3_結果\結果.xls"
　　StName = "Sheet1"
Dim sWbkSubName As String
sWbkSubName = "1_算定表\" & vTgYear & "_算定表.xls"
Dim Kname As String, Mname As String
Kname = sMyDir & sWbkName
Mname = sMyDir & sWbkSubName

Dim buf As String
On Error GoTo myError
Open sMyDir & "3_結果\結果.xls" For Input As #1
Line Input #1, buf
Close #1

On Error GoTo ErrorHandler2
If Dir(Mname) <> "" Then
Workbooks.Open Filename:=Mname, Password:="aaaaa"
Else

Dim Wb1 As Workbook
Set Wb1 = Workbooks("結果.xls")
Set wbk結果 = Wb1.Sheets(StName)

Dim wbkA As Variant
Dim sShtName As String
sShtName = "地域1"
Dim Wb2 As Workbook
Set Wb2 = Workbooks(vTgYear & "_算定表.xls")
Set wbk地域A = Wb2.Sheets(sShtName)
wbk結果.Range("F9:N9").Value = wbk地域A.Range("AB7:AK7").Value
wbk結果.Range("F10:N10").Value = wbk地域A.Range("AB51:AK51").Value
wbk結果.Range("F11:N11").Value = wbk地域A.Range("AB95:AK95").Value
wbk結果.Range("F12:N12").Value = wbk地域A.Range("AB139:AK139").Value
wbk結果.Range("F13:N13").Value = wbk地域A.Range("AB183:AK183").Value
wbk結果.Range("F14:N14").Value = wbk地域A.Range("AB227:AK227").Value
wbk結果.Range("F15:N15").Value = wbk地域A.Range("AB271:AK271").Value
wbk結果.Range("F16:N16").Value = wbk地域A.Range("AB315:AK315").Value

≪後略≫

Application.DisplayAlerts = False
wbk結果1.SaveAs Filename:=sMyDir & "3_結果\" & vTgYear & "_テスト.xls" '
Application.DisplayAlerts = True

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

Workbooks(vTgYear & "_算定表.xls").Close SaveChanges:=False

MsgBox "計算期間" & "「" & kenko_Label_10 & "」で" & vbLf & "ファイルを作成しました。", vbInformation

Close #1
Exit Sub
myError:
MsgBox "出力先の「結果_健康寿命」ファイルが存在しません。" & _
vbLf & "処理を終了します。", vbOKOnly + vbExclamation

Exit Sub
ErrorHandler2:
MsgBox "指定年の「長野県健康寿命算定表」" & _
vbLf & "ファイルが存在しません。処理を終了します。", vbOKOnly + vbExclamation
End If

End Sub

'//////////////////////////////////////////////////////

メッセージ画面以外は正常に動作することを確認しています。
メッセージ画面について教えてください。
素人で申し訳ありませんが、よろしくお願い致します。

回答No.2

noname#203218 · ベストアンサー

openステートメント前にｄｉｒでファイルの有無をチェックする方法は如何ですか？
openステートメントのエラーハンドルは不要となります。
メッセージの表示させるコードを最下位にもっていきたいのであればmsgboxを指定している箇所にGoToでも使用して下さい。

ご参考まで。

Kname = sMyDir & sWbkName
Mname = sMyDir & sWbkSubName

-----------------------------------------------
ここから追加

Dim kflag, mflag As Integer

'それぞれのファイルが無い場合フラグを０、あればフラグ１にする。
If Dir(Kname) = "" Then kflag = 0 Else kflag = 1
If Dir(Mname) = "" Then mflag = 0 Else mflag = 1

'両ファイルが存在する場合は、GoTo mystartでVBA続行、存在しない場合、メッセージを表示しsubを抜ける
If kflag = 1 And mflag = 1 Then
GoTo mystart
Else
If kflag = 1 Then
MsgBox "指定年の「長野県健康寿命算定表」" & _
vbLf & "ファイルが存在しません。処理を終了します。", vbOKOnly + vbExclamation
ElseIf mflag = 1 Then
MsgBox "出力先の「結果_健康寿命」" & _
vbLf & "ファイルが存在しません。処理を終了します。", vbOKOnly + vbExclamation
Else
MsgBox "指定年の「長野県健康寿命算定表」及び出力先の「結果_健康寿命」" & _
vbLf & "ファイルが存在しません。処理を終了します。", vbOKOnly + vbExclamation
End If

Exit Sub
End If

mystart:

ここまで
-----------------------------------------------------------------------
Dim buf As String
Open sMyDir & "3_結果\結果.xls" For Input As #1
Line Input #1, buf
Close #1

お礼

修正させていただきましたが、ご提供いただいたコードを参考にやりたいことが実現できました。ありがとうございました。

回答No.1

satoron666

http://officetanaka.net/excel/vba/file/file01.htm

上記参考に考えてみてください。