VBAのキャンセル処理

質問

下記のVBAでファイルを出力することはできるようになったのですが、
出力するときに[キャンセル]を押しても"MsgBox ：Excelファイルへの出力が完了しました。"が表示されてしまいます。

「キャンセル」した場合は、このメッセージが表示されないようにできないでしょうか？

Private Sub Image_Export_Click()
On Error GoTo Err_FileDialog_Click

'ファイル出力
Dim strFileName As String
Dim ExpFileName As String

ExpFileName = "T_master_" & Format(Now(), "yyyymmdd")

strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "", ExpFileName & ".xls")
If Len(strFileName) = 0 Then
'キャンセルボタンが押されたときの処理を記述
MsgBox "キャンセルが押されました。"
Else
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "T_master", strFileName & ".xls", True

End If
MsgBox "Excelファイルへの出力が完了しました。", , "出力完了"
Exit_FileDialog_Click:
Exit Sub

Err_FileDialog_Click:
MsgBox "予期せぬエラーが発生しました" & Chr(13) & _
"エラーナンバー：" & Err.Number & Chr(13) & _
"エラー内容：" & Err.Description, vbOKOnly
End
Resume Exit_FileDialog_Click
End Sub

回答No.3

chie65536（@chie65535） · ベストアンサー

＞下記のHPに記載のあったWhizhookオブジェクトのまま使用しているのですが、問題ありますでしょうか？

問題ありありです。

貴方が行なった「勝手な改造」により

「GetFileNameの中でキャンセルされたら、返って来る文字列が、長さ０の文字列になる」

と言う仕様が、仕様通りになっていません。

で、補足説明にあるページのサンプルですが

Dim strFilePath As String

と変数を宣言して、strFilePathが「長さ０の文字列」になった状態で

returnValue = WizHook.GetFileName( _

と呼び出して、呼び出した後、returnValueが何になっているか調べないで

GetFileName = strFilePath

と、戻り値をセットしています。

キャンセルされたかファイルが選択されたか調べる場合は、本当は、returnValueの値を調べないといけないのですが

strFilePath変数を宣言して、strFilePathが「長さ０の文字列」になった状態で、WizHook.GetFileName()を呼び出し、WizHook.GetFileName()がキャンセルされると、strFilePathが「長さ０の文字列」のまま変更されずに返って来る

と言う動作をするので

strFilePathが「長さ０の文字列」の時は、キャンセルされて帰って来た

と判断しているのです。

ところが、あなたは、勝手に改造して

Dim strFilePath As String

の後に

strFilePath = strDefaultPath

という処理を入れてしまいました。すると、

WizHook.GetFileName()を呼び出し、WizHook.GetFileName()がキャンセルされると、strFilePathがstrDefaultPathの内容のまま返って来る

という動作をするようになりました。

つまり「キャンセルしても、長さが０じゃない文字列が返って来る」のです。

呼び出している方は「長さ０の文字列が返ってくればキャンセルされた」と判断しているので、結局「いくらキャンセルしても、キャンセルされた事にならない」のです。

なので、当方や他の回答者さんが示した修正をしても「いくらキャンセルしても、キャンセルされた事にならない」動作をします。

今の仕様（質問者さんが改造したままの仕様）で、ちゃんとキャンセルされたか判定したい場合は

WizHook.Key = 0 ' WizHook 無効
GetFileName = strFilePath

の部分を

WizHook.Key = 0 ' WizHook 無効
'正常終了なら０が返るので、正常終了か調べる
If returnValue = 0 then
'正常終了したらファイル名を返す
GetFileName = strFilePath
Else
'キャンセルされたなら長さ０の文字列を返す
GetFileName = ""
End If

というように改造して下さい。

他人が作ったプログラムを改造する場合は「貴方の改造が、関数の動作仕様に影響を与えない事を、必ず確認」しましょう。

今回は、呼び出される側の「誤動作するように改造された関数が提示された」ので、バグの原因が判明しましたが、もし、提示されなかったなら「正常に動かない原因が判らない」と言う回答しか得られなかった筈です。今回は「非常に運が良かった」と思います。

お礼

chie65535さん

教えていただいた箇所を修正したら、きちんと動作いたしました。
また、丁寧に解説していただきましてありがとうございます。
今後は、変更する前に変更後の動作に影響を与えないことを確認します。

回答No.4

chie65536（@chie65535）

因みに。

貴方が参考にした

http://vba-geek.jp/blog-entry-53.html

のページは、たぶん

http://www.f3.dion.ne.jp/~element/msaccess/AcTipsGetFileName.html

の記事を参考に書かれた物だろうと思われます。

後者の記事には、ちゃんと

キャンセルされた場合は、実際には GetFileName の戻り値が 0 以外（Windows XP 上での確認では -302）になることをもって判定するのが正規の方法ですが、今回は戻り値を無視して、パスに空文字列が返ればキャンセルとみなして簡略化しています。

と「簡略化している事実」を明記しています。

ところが、後者の記事をパクって書いた前者の方は、その事をちゃんと書いていません。

この「簡略化してしまって、戻り値をちゃんと見てないよ」っていう「重要な事実」が、元記事と同様にパクり記事の方にも明記してあれば、質問者さんのような被害者は出なかった筈です。

今後は「どこからかパクってきたような、余り信用できないブログ記事は使わない」ようにしましょう。

回答No.2

chie65536（@chie65535）

MsgBox "キャンセルが押されました。"
の次の行に
Exit Sub
と言う行を追加しましょう。

それが無いと
MsgBox "キャンセルが押されました。"
が実行された後、if文の最後のEnd ifの次の行から実行されてしまいます。

「if文の最後のEnd ifの次の行」とは、もちろん
MsgBox "Excelファイルへの出力が完了しました。", , "出力完了"
の行の事です。

以下、蛇足ですが。

「GetFileName」という自作関数ですが、同名の既存メソッドが存在するので、この名前は使用しない方が良いでしょう。

ウッカリして、同名の既存メソッドを呼ぶつもりで、自作関数を呼んでしまったりするケアレスミスが発生し、バグの原因になります。

補足

chie65535さん

回答ありがとうございます。

教えていただいた箇所にExit subを記入してみたのですが、ダイアログボックスでキャンセルを押しても、MsgBox "Excelファイルへの出力が完了しました。", , "出力完了"が表示されてしまいます。

また、「GetFileName」についてですが、下記のHPに記載のあったWhizhookオブジェクトのまま使用しているのですが、問題ありますでしょうか？

<http://vba-geek.jp/blog-entry-53.html>

【修正後】
Private Sub Image_Export_Click()

On Error GoTo Err_FileDialog_Click

'ファイル出力
Dim strFileName As String
Dim ExpFileName As String

ExpFileName = "T_master_" & Format(Now(), "yyyymmdd")

strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "", ExpFileName & ".xls")
If Len(strFileName) = 0 Then
'キャンセルボタンが押されたときの処理を記述

MsgBox "キャンセルが押されました。"
Exit Sub

Else

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "T_master", strFileName & ".xls", True
MsgBox "Excelファイルへの出力が完了しました。", , "出力完了"

End If

Exit_FileDialog_Click:
Exit Sub

Err_FileDialog_Click:
MsgBox "予期せぬエラーが発生しました" & Chr(13) & _
"エラーナンバー：" & Err.Number & Chr(13) & _
"エラー内容：" & Err.Description, vbOKOnly
End
Resume Exit_FileDialog_Click
End Sub

【標準モジュール】
Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, _
strTitle As String, strDefaultPath As String) As String

Dim returnValue As Integer
Dim strFilePath As String
strFilePath = strDefaultPath

If strFilter = "" Then
strFilter = "全てのファイル (*.*)|*.*"
End If

WizHook.Key = 51488399 'WIZHOOK有効
returnValue = WizHook.GetFileName( _
0, "", strTitle, "", strFilePath, "", _
strFilter, _
0, 0, 0, OpenOrSaveFlg _
)
WizHook.Key = 0 ' WizHook 無効
GetFileName = strFilePath

End Function

回答No.1

ggggggggggg hhhhhhhhhhh（@tasketeqq1）

MsgBox "Excelファイルへの出力が完了しました。", , "出力完了"
End If
というふうにif文のなかにいれればいいのでは....

補足

tasketeqq1さん

回答ありがとうございます

教えていただいた通り、やってみたのですが、MsgBoxが表示されてしまいます。

Private Sub Image_Export_Click()

On Error GoTo Err_FileDialog_Click
'ファイル出力
Dim strFileName As String
Dim ExpFileName As String

ExpFileName = "T_master_" & Format(Now(), "yyyymmdd")

strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "", ExpFileName & ".xls")
If Len(strFileName) = 0 Then
'キャンセルボタンが押されたときの処理を記述

MsgBox "キャンセルが押されました。"
Exit Sub

Else
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "T_master", strFileName & ".xls", True
MsgBox "Excelファイルへの出力が完了しました。", , "出力完了"

End If

Exit_FileDialog_Click:
Exit Sub

Err_FileDialog_Click:
MsgBox "予期せぬエラーが発生しました" & Chr(13) & _
"エラーナンバー：" & Err.Number & Chr(13) & _
"エラー内容：" & Err.Description, vbOKOnly
End
Resume Exit_FileDialog_Click

End Sub