Option Explicit
'-------------------------------------------------------------------------------
' ■CloseはせずにQuitを発行します。
Sub Quit_TEST1()
MsgBox "CloseはせずにQuitを発行します。"
Call Quit_TEST1_Sub
MsgBox "終わらないよ!!(TEST1)"
End Sub
' Closeはしないで終了するサブ処理
Private Sub Quit_TEST1_Sub()
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True
' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit
End Sub
'***************************************************************************************************
' ※Application.Quitテスト ThisWorkbook(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
' ・Microsoft Scripting Runtime
' ・Windows Script Host Object Model
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容---------------------------------------------------------------------->
' 17/11/07(1.0.0)新規作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsLogFolder As String = "LOG"
Private Const g_cnsLogFilename As String = "QuitTEST.log"
'***************************************************************************************************
' ■■■ シート上のボタンからの起動処理 ■■■
'***************************************************************************************************
'* 処理名 :Quit_TEST1
'* 機能 :「CloseはしないままQuitさせます。」ボタン処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub Quit_TEST1()
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST1(Start)")
'-----------------------------------------------------------------------------------------------
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True
' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST1(End)")
End Sub
'***************************************************************************************************
'* 処理名 :Quit_TEST2
'* 機能 :「CloseさせてからQuitさせます。」ボタン処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub Quit_TEST2()
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST2(Start)")
'-----------------------------------------------------------------------------------------------
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True
' 本ブックをClose
ThisWorkbook.Close False
' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST2(End)")
End Sub
'***************************************************************************************************
'* 処理名 :Quit_TEST3
'* 機能 :「QuitさせてからCloseさせます。」ボタン処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub Quit_TEST3()
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST3(Start)")
'-----------------------------------------------------------------------------------------------
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True
' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit
' 本ブックをClose
ThisWorkbook.Close False
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST3(End)")
End Sub
'***************************************************************************************************
' ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :GP_OutputLog
'* 機能 :ログ出力
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = ログテキスト(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub GP_OutputLog(ByVal strLogRec As String)
'-----------------------------------------------------------------------------------------------
Dim objFso As FileSystemObject ' FileSystemObject
Dim objTs As TextStream ' TextStream
Dim strFilename As String ' ファイル名
Dim strRec As String ' レコードWORK
Set objFso = New FileSystemObject
' ログファイル名取得
strFilename = FP_GetLogFilename(objFso)
' ログの出力(追記)
Set objTs = objFso.OpenTextFile(strFilename, ForAppending, True)
strRec = Format(Now, "yyyy/MM/dd HH:mm:ss") & " " & strLogRec
objTs.WriteLine strRec
objTs.Close
Set objTs = Nothing
Set objFso = Nothing
End Sub
'***************************************************************************************************
'* 処理名 :FP_GetLogFilename
'* 機能 :ログファイル名取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :ログファイル名(String)
'* 引数 :Arg1 = FileSystemObject(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_GetLogFilename(ByRef objFso As FileSystemObject) As String
'-----------------------------------------------------------------------------------------------
Dim strPathname As String ' フォルダ名
' "LOG"フォルダ名(フルパス)の編集
With New WshShell
strPathname = objFso.BuildPath(.SpecialFolders("MyDocuments"), g_cnsLogFolder)
End With
' "LOG"フォルダの作成
If Not objFso.FolderExists(strPathname) Then
objFso.CreateFolder strPathname
End If
' "LOG"ファイル名(フルパス)の編集
FP_GetLogFilename = objFso.BuildPath(strPathname, g_cnsLogFilename)
End Function
'------------------------------------------<< End of Source >>--------------------------------------
'***************************************************************************************************
' ※Application.Quitテスト ThisWorkbook(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容---------------------------------------------------------------------->
' 17/11/07(1.0.0)新規作成
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ ワークブックイベント ■■■
'***************************************************************************************************
'* 処理名 :Workbook_BeforeClose
'* 機能 :Close前イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = キャンセル(Boolean) ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'-----------------------------------------------------------------------------------------------
Call GP_OutputLog("Workbook_BeforeClose")
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
2017/11/05 08:15:05 Quit_TEST1(Start)
2017/11/05 08:15:05 Quit_TEST1(End)
2017/11/05 08:15:05 Workbook_BeforeClose
2017/11/05 08:15:58 Quit_TEST2(Start)
2017/11/05 08:15:58 Workbook_BeforeClose
2017/11/05 08:16:28 Quit_TEST3(Start)
2017/11/05 08:16:28 Workbook_BeforeClose
'***************************************************************************************************
'* 処理名 :Quit_TEST1
'* 機能 :「CloseはしないままQuitさせます。」ボタン処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月12日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub Quit_TEST1()
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST1(Start)")
'-----------------------------------------------------------------------------------------------
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True
' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit
'###############################################################################################TEST
Stop
'###############################################################################################TEST
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST1(End)")
End Sub
2017/11/12 09:56:15 Quit_TEST1(Start)
2017/11/12 09:56:15 Workbook_BeforeClose
' ■スリープ(API)
Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
'***************************************************************************************************
'* 処理名 :Quit_TEST1
'* 機能 :「CloseはしないままQuitさせます。」ボタン処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年11月07日
'* 作成者 :井上 治
'* 更新日 :2017年11月12日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub Quit_TEST1()
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST1(Start)")
'-----------------------------------------------------------------------------------------------
' 保存確認を避けるため、保存済みにする
ThisWorkbook.Saved = True
' 他にブックが開いていなければ、Excelを終了する
If Workbooks.Count <= 1 Then Application.Quit
'###############################################################################################TEST
' ログ出力
Call GP_OutputLog("スリープで5秒停止します")
' スリープで5秒停止させてみる
Sleep 5000
' ログ出力
Call GP_OutputLog("スリープで5秒停止しました")
'###############################################################################################TEST
'-----------------------------------------------------------------------------------------------
' ログ出力
Call GP_OutputLog("Quit_TEST1(End)")
End Sub
2017/11/12 11:43:25 Quit_TEST1(Start)
2017/11/12 11:43:25 スリープで5秒停止します
2017/11/12 11:43:30 スリープで5秒停止しました
2017/11/12 11:43:30 Quit_TEST1(End)
2017/11/12 11:43:30 Workbook_BeforeClose