Msgbox随机崩溃Excel答案

【问题标题】：Msgbox Crashing Excel RandomlyMsgbox随机崩溃Excel
【发布时间】：2021-11-04 19:49:07
【问题描述】：

背景

我在许多机器上遇到过这个问题，不同的 excel 配置并且没有链接到特定的代码。
我喜欢在代码执行结束时为用户提供一个消息框，比如“OK01：执行成功！”

问题

消息框随机崩溃 Excel 实例。没有真正的调试方法，因为当它被调试时，它按预期工作，但它只发生在随机场合：可能是第一次运行，第二次运行后，第五次，第十次等等；内存上的程序相同或尽可能多的被关闭；仅打开一个文件或多个文件的 Excel 实例。比方说，PC 的多种常见场景。

注意事项

文件是从头开始创建的，甚至不会发生模块导入。每当我做一个宏时，我都会使用以下结构。如果 Call ExcelNormal 在 MessageBox 之前或之后，就会发生这种情况；即使它也是执行中唯一的消息框，它也会发生。

代码

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

没有真正一致的代码会引发这种行为，所以我插入了一张图片来说明它。

问题

我不太确定用户窗体是否会解决它，我怀疑与显示消息框相关的一些内存问题；有没有办法以某种方式清理它或防止他的行为？我试图寻找这方面的文档，但我没有找到任何关于这个特定场景的东西。

基于 Cristian Buse 解决方案

我更改了第一个消息框的 End，但结果相同。我找到了一种让其他人重现该行为的方法，我编辑了我的原始代码。

通过“手动”记录，我仍然无法记录正在发生的事情（尽管正如我在 cmets 上所说，我现在的猜测是它试图显示“内存不足”并崩溃），我分享了我的使用这个巧妙的解决方案发现

Log when crashed first run
[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] 
Log when crashed on 7th run (as I said, it could happen on the nth run, the most annoying one is the first one)
[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] 和 on第二条日志在 [2021-11-05 11:43:57][ConsoleLog] 行第 7 次运行后崩溃。

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

【问题讨论】：

您是否安装/加载了任何加载项？
第一个 MsgBox 说：“Ask01Exec_RoutinesToRun：请确认您要运行以下内容：*-Exec_ExchangeVariation”|第二个 MsgBox 说：“Ok01Exec_RoutinesToRun：完成！” | @Sgdva：这意味着它与所示的代码不完全相同。您能否确认（如您的文本中所建议的那样）显示的代码会引发崩溃？
@Sgdva，我意识到您已经完成了自己的故障排除并得出了您的结论，但我坚持认为这是一个奇怪的问题，我不记得过去看到过......如何使用类似： debug.print "made it this far" Application.Wait (Now() + TimeValue("00:00:10")) 如果 Excel 在您看到错误消息之前仍然关闭，那么它就是消息框.如果它等待然后关闭，那么您可以开始查看过程调用。
如果你创建一个新的 excel 文件，只有 1 个子文件和 MsgBox "Test"，你能重现这个吗？
@dra_red 谢谢你，我现在是用户，消息框没有显示，它只是崩溃所以不能点击。

标签： excel vba messagebox

【解决方案1】：

首先，您不应该单独使用End。它清除了整个状态（所有变量在整个项目中都失去了价值）并且可能只是你所有问题的原因。请改用Exit Sub 或Exit Function。替换：

If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then End

与：

If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub

如果这不能解决您的问题，那么以下代码将帮助您进行调试：

Option Explicit

'Rudimentary Logging
Const LOG_FILE_PATH As String = "C:\Users\<yourUserName>\Desktop\RudLog.txt"


Public Sub LogTextToFile(ByVal procName As String, ByVal textToLog As String)
    Dim fileNumber As Long: fileNumber = FreeFile
    '
    On Error Resume Next
    Open LOG_FILE_PATH For Append Access Write Lock Write As fileNumber
    Print #fileNumber, "[" & Format$(Now(), "yyyy-mm-dd hh:mm:ss") & "][" & procName & "] " & textToLog
    Close fileNumber
    On Error GoTo 0
End Sub

Public Sub ClearLogFile()
    Dim fileNumber As Long: fileNumber = FreeFile
    '
    On Error Resume Next
    Open LOG_FILE_PATH For Output Access Write Lock Write As fileNumber
    Close fileNumber
    On Error GoTo 0
End Sub

只需将LOG_FILE_PATH 值替换为有效路径即可。文本文件名可以是任何内容。只要文件夹有效且文件名中包含有效字符，就会为您创建文件。

您的Sample 程序可以变成：

Sub Sample()
    If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub
    LogTextToFile "Sample", "Before calling ExcelBusy"
    Call ExcelBusy
    LogTextToFile "Sample", "After calling ExcelBusy"
    'code
    LogTextToFile "Sample", "Before MsgBox"
    MsgBox "Ok01Exec_RoutinesToRun: Done!", vbOKOnly
    LogTextToFile "Sample", "After MsgBox"
    'code
    LogTextToFile "Sample", "Before calling ExcelNormal"
    Call ExcelNormal
    LogTextToFile "Sample", "After calling ExcelNormal"
End Sub

在我的电脑上，上面将以下内容写入文本文件：

[2021-11-05 09:05:56][Sample] Before calling ExcelBusy
[2021-11-05 09:05:56][Sample] After calling ExcelBusy
[2021-11-05 09:05:56][Sample] Before MsgBox
[2021-11-05 09:05:57][Sample] After MsgBox
[2021-11-05 09:05:57][Sample] Before calling ExcelNormal
[2021-11-05 09:05:59][Sample] After calling ExcelNormal

当然，您可以在其他方法中添加尽可能多的日志记录行，以准确查看崩溃前的最后一行。

编辑#1

正如@Ike 在 cmets 部分所建议的那样，长代码行会影响可读性并使问题更难发现。

一个很好的替代品：

If MsgBox("Please confirm that you want to run the following code", vbYesNo) = vbNo Then Exit Sub

可能是：

Dim res As VbMsgBoxResult
res = MsgBox(Prompt:="Please confirm that you want to run the following code" _
           , Buttons:=vbYesNo _
           , Title:="Please confirm")
If res = vbNo Then Exit Sub

甚至：

If MsgBox(Prompt:="Please confirm that you want to run the following code" _
        , Buttons:=vbYesNo _
        , Title:="Please confirm") = vbNo Then Exit Sub

【讨论】：

很好的发现：“结束” - 又是一个为什么应该避免长代码行的例子。
@Ike 确实。为了可读性和维护，我尽量避免排长队。我曾经看到 End 使某人的 VBA 项目崩溃，但仅在运行 End 5 次之后。由于这很奇怪，我提出进行调查，后来发现他在另一个模块中有一些代码正在为某些对象复制一些内存，但他是以非托管方式进行的，因此最终发生了 GPF 错误。他一直在随机崩溃，只是偶然他发现了导致我们遇到问题的 5 次 End 案例。在 Op 的情况下可能是类似的。
可能你应该编辑你的例子 - 并相应地打破 msgbox 行 - 以显示更好的可读性:-)
@Ike 好点！
首先，这个场景的调试方式很好，很有创意。我接受了您关于将 end 更改为 Exit Sub 的建议，但这种行为仍然会发生。遗憾的是，记录它的方式并没有解决它，也没有让我得到结果/其他线索。请参阅我更新的问题。