Excel VBA宏调用MsgBox时随机触发Excel实例崩溃问题求助

我在多台机器、不同Excel配置环境下均遇到该问题，且不与特定代码绑定。我习惯在代码执行结束后弹出MsgBox提示用户，比如“OK01: Performed succesfully!”

MsgBox会随机导致Excel实例崩溃，无法正常调试：调试模式下运行完全符合预期，崩溃仅随机发生，可能首次运行就崩溃，也可能第2、5、10次运行才崩溃；覆盖内存中程序一致或已尽可能关闭其他程序、Excel仅打开单个文件或多个文件等多种PC常用场景。

测试文件均为全新创建，未导入任何模块，我编写宏时统一使用如下代码结构。无论Call ExcelNormal语句放在MsgBox之前或之后均会触发崩溃，即便整个执行流程仅存在一个MsgBox也会出现该问题。

Sub Sample()
If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub
Call ExcelBusy
Call Exec_CreateSheets("Sheet2")
Call Exec_ImportExcelFile("Dummy", Sheets(1).Range("A1"), True, True, True, "Sheet1", TxtPathForFile:="C:\Users\UserName\Desktop\Testfile.xlsx")
MsgBox "Ok01Exec_RoutinesToRun: Done!", vbOKOnly
Call ExcelNormal
End Sub
Sub ExcelNormal()
With Excel.Application
.Cursor = xlDefault
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
.AskToUpdateLinks = True
.StatusBar = False
.EnableEvents = True
End With
End Sub
Sub ExcelBusy()
With Excel.Application
.Cursor = xlWait
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
.AskToUpdateLinks = False
.StatusBar = False
.EnableEvents = False
End With
End Sub
Function Return_IsExcelFileLocked(ByVal TxtFile As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open TxtFile For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
' Display the error number and description.
MsgBox "Error01Return_IsExcelFileLocked: #" & Str(Err.Number) & " - " & Err.Description & ": If file is open please close it."
Return_IsExcelFileLocked = True
Err.Clear
End If
End Function
Sub Exec_ImportExcelFile(ByVal TxtSheetToCreate As String, ByVal RangeDataBegins As Range, ByVal IsNeededAsValuesOnly As Boolean, ByVal IsPartOfSubs As Boolean, ByVal IsImportedSheetVisible As Boolean, Optional ByVal TxtSheetToImport As String, Optional ByVal IsImportedFileNeededToBeDeleted As Boolean, Optional ByVal TxtPathForFile As String)
Dim WBToImport As Workbook
Dim WBOriginal As Workbook
Dim TxtFileToImport As String
Dim VarValueFromMsg As Variant
If TxtPathForFile = "" Then ' 2. If TxtPathForFile = ""
MsgBox "War01Exec_ImportExcelFile: If the file for the " & TxtSheetToCreate & " is opened, please close it before importing", vbExclamation
VarValueFromMsg = Application.GetOpenFilename(Title:="Please choose the " & TxtSheetToCreate & " file", fileFilter:=TxtSheetToCreate & " (*.xls;*.xlsx;*.xlsm;*.csv),*.xls;*.xlsx;*.xlsm;*.csv", ButtonText:=TxtSheetToCreate, MultiSelect:=False)
On Error GoTo Err01Exec_ImportExcelFile
If VarValueFromMsg = False Then Call ExcelNormal: End
Err01Exec_ImportExcelFile:
Else ' 2. If TxtPathForFile = ""
VarValueFromMsg = TxtPathForFile
End If ' 2. If TxtPathForFile = ""
If IsPartOfSubs = False Then Call ExcelBusy
Set WBOriginal = ThisWorkbook
TxtFileToImport = CStr(VarValueFromMsg)
If Return_IsExcelFileLocked(TxtFileToImport) = True Then Call ExcelNormal: End
Call Exec_CreateSheets(TxtSheetToCreate)
On Error GoTo Err02Exec_ImportExcelFile
Set WBToImport = Workbooks.Open(Filename:=TxtFileToImport, ReadOnly:=True)
If TxtSheetToImport = "" Then TxtSheetToImport = WBToImport.ActiveSheet.Name
Call Exec_ShowAllDataInSheet(TxtSheetToImport, WBToImport)
With WBToImport
Application.CutCopyMode = False
If IsNeededAsValuesOnly = True Then ' 1. If IsNeededAsValuesOnly = True
.Sheets(TxtSheetToImport).Range(.Sheets(TxtSheetToImport).Cells(RangeDataBegins.Row, RangeDataBegins.Column), .Sheets(TxtSheetToImport).Cells(.Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Row, .Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Column)).Copy
'.Sheets(TxtSheetToImport).Range(.Sheets(TxtSheetToImport).Cells(RangeDataBegins.Row, RangeDataBegins.Column), .Sheets(TxtSheetToImport).Cells(.Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Row, .Sheets(TxtSheetToImport).Cells.SpecialCells(xlCellTypeLastCell).Column)).Copy
WBOriginal.Sheets(TxtSheetToCreate).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else ' 1. If IsNeededAsValuesOnly = True
.Sheets(TxtSheetToImport).Range(RangeDataBegins.Address).CurrentRegion.Copy Destination:=WBOriginal.Sheets(TxtSheetToCreate).Cells(1, 1)
End If ' 1. If IsNeededAsValuesOnly = True
End With
WBToImport.Close False, False
DoEvents
Application.CutCopyMode = False
If IsImportedFileNeededToBeDeleted = True Then Kill (VarValueFromMsg)
WBOriginal.Activate
Sheets(TxtSheetToCreate).Visible = IsImportedSheetVisible
DoEvents
'trying to address memory leaks when called by subs
Set WBToImport = Nothing: Set WBOriginal = Nothing
If IsPartOfSubs = False Then Call ExcelNormal
If 1 = 2 Then ' 99. If error
Err02Exec_ImportExcelFile:
MsgBox "Err02Exec_ImportExcelFile: Excel could not find the file at '" & TxtFileToImport & "'. Make sure the file exists!" & Chr(10) & "Further Details: " & Err.Description, vbCritical: Call ExcelNormal: End
End If ' 99. If error
End Sub
Sub Exec_ShowAllDataInSheet(ByVal TxtSheet As String, Optional ByVal WBParent As Workbook)
If WBParent Is Nothing Then Set WBParent = ThisWorkbook
On Error GoTo Err01Exec_ShowAllDataInSheet
WBParent.Sheets(TxtSheet).Visible = True
On Error Resume Next
WBParent.Sheets(TxtSheet).ShowAllData
WBParent.Sheets(TxtSheet).EntireRow.Hidden = False
WBParent.Sheets(TxtSheet).EntireColumn.Hidden = False
'trying to address memory leaks when called by subs
Set WBParent = Nothing
If 1 = 2 Then ' 99. If error
Err01Exec_ShowAllDataInSheet:
MsgBox "Err01Exec_ShowAllDataInSheet: Sheet " & TxtSheet & " does not exists!", vbCritical: Call ExcelNormal: End
End If ' 99. If error
End Sub
Sub Exec_CreateSheets(ByVal NameSheet As String, Optional ByVal Looked_Workbook As Workbook)
If Looked_Workbook Is Nothing Then Set Looked_Workbook = ThisWorkbook
Dim SheetExists As Worksheet
On Error GoTo ExpectedErr01CreateSheets
Set SheetExists = Looked_Workbook.Worksheets(NameSheet)
SheetExists.Delete
ExpectedErr01CreateSheets:         'this means sheet didn't existed so, we are going to create it
With Looked_Workbook
.Sheets.Add After:=.Sheets(.Sheets.Count)
ActiveSheet.Name = NameSheet
'trying to address memory leaks when called by subs
Set Looked_Workbook = Nothing
End With
End Sub

无稳定复现该问题的代码逻辑，崩溃表现为MsgBox即将弹出时Excel进程直接退出，无前置报错信息。

不确定改用UserForm能否解决该问题，怀疑是弹出MsgBox时触发的内存相关问题，是否有清理相关内存或规避该行为的方案？查阅相关文档未找到对应场景的解决方法。

基于Cristian Buse方案测试：修改了第一个MsgBox后的End语句，仍出现相同问题，已编辑原代码提供了复现方法。
通过手动打日志仍无法定位问题原因（目前猜测是尝试弹出“内存不足”提示时崩溃），相关日志如下：

首次运行崩溃日志
[2021-11-05 11:43:17][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:19][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:27][Before messagebox] Before messagebox
[2021-11-05 11:43:27][ConsoleLog] 
第7次运行崩溃日志（崩溃可能发生在任意第n次运行，最影响使用的是首次运行就崩溃的场景）
[2021-11-05 11:43:32][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:33][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:35][Before messagebox] Before messagebox
[2021-11-05 11:43:35][ConsoleLog] 
[2021-11-05 11:43:35][ExcelNormal] 
[2021-11-05 11:43:36][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:38][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:39][Before messagebox] Before messagebox
[2021-11-05 11:43:39][ConsoleLog] 
[2021-11-05 11:43:39][ExcelNormal] 
[2021-11-05 11:43:40][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:41][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:43][Before messagebox] Before messagebox
[2021-11-05 11:43:43][ConsoleLog] 
[2021-11-05 11:43:43][ExcelNormal] 
[2021-11-05 11:43:44][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:45][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:47][Before messagebox] Before messagebox
[2021-11-05 11:43:47][ConsoleLog] 
[2021-11-05 11:43:47][ExcelNormal] 
[2021-11-05 11:43:48][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:49][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:50][Before messagebox] Before messagebox
[2021-11-05 11:43:50][ConsoleLog] 
[2021-11-05 11:43:50][ExcelNormal] 
[2021-11-05 11:43:51][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:52][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:54][Before messagebox] Before messagebox
[2021-11-05 11:43:54][ConsoleLog] 
[2021-11-05 11:43:54][ExcelNormal] 
[2021-11-05 11:43:55][Exec_CreateSheets] Before calling ExcelBusy
[2021-11-05 11:43:56][Exec_ImportExcelFile] After Importing Excel
[2021-11-05 11:43:57][Before messagebox] Before messagebox
[2021-11-05 11:43:57][ConsoleLog] 

崩溃发生在ConsoleLog打印完成后，首次运行崩溃发生在第一次运行代码打印[2021-11-05 11:43:27][ConsoleLog]后，第二次崩溃发生在第7次运行代码打印[2021-11-05 11:43:57][ConsoleLog]后。

加日志后的测试代码如下：

Sub Sample()
    If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub
    Call ExcelBusy
    Call Exec_CreateSheets("Sheet2")   
    LogTextToFile "Exec_CreateSheets", "Before calling ExcelBusy"
    Call Exec_ImportExcelFile("Dummy", Sheets(1).Range("A1"), True, True, True, "Sheet1", TxtPathForFile:="C:\Users\UserName\Desktop\Testfile.xlsx"
    LogTextToFile "Exec_ImportExcelFile", "After Importing Excel"
    LogTextToFile "Before messagebox", "Before messagebox"
    LogTextToFile "ConsoleLog", Err.Description
    MsgBox "Ok01Exec_RoutinesToRun: Done!", vbOKOnly
    Call ExcelNormal
    LogTextToFile "ExcelNormal", Err.Description
End Sub

内容的提问来源于stack exchange，提问作者Sgdva