excel - Msgbox随机崩溃Excel

标签 excel vba messagebox

背景
我在许多机器上遇到过这个问题,不同的 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
没有真正一致的代码会引发这种行为,所以我插入了一张图片来说明它。
MessageBox Crash
问题
我不太确定用户窗体是否会解决它,我怀疑与显示消息框相关的一些内存问题;有没有办法以某种方式清理它或防止他的行为?我试图寻找这方面的文档,但我没有找到任何关于这个特定场景的东西。
基于 Cristian Bus 解决方案
我更改了第一个消息框的 End 但结果相同。我找到了一种让其他人重现行为的方法,我编辑了我的原始代码。
通过“手动”记录,我仍然无法记录正在发生的事情(尽管正如我在评论中所说,我现在的猜测是它试图显示“内存不足”并崩溃),我通过使用分享我的发现这个巧妙的解决方案
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] 和第二个日志时崩溃[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

最佳答案

首先你不应该使用 End 在其自己的。它清除了整个状态(所有变量在整个项目中都失去了值(value))并且可能只是你所有问题的原因。而是使用 Exit SubExit 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 在评论部分所建议的那样,长行代码会影响可读性并使问题更难被发现。
一个很好的替代品:
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

关于excel - Msgbox随机崩溃Excel,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/69845042/

相关文章:

excel - 未发生错误时执行的错误处理程序

excel - 如何在 Excel 中进行分布式计算

c++ - QT中如何在消息框中显示图标?

java - 在 gui 对话框中打印多行 while 循环 (Java)

.net - 像 StackOverflow 一样生成 "toast"消息

c# - 当工作表名称以编程方式包含空格时如何从工作表中获取 Excel 工作表

string - 如何在字符串vba中包含引号

excel - Excel VBA 宏中的动态范围不正确

vba - 在 Excel VBA 中选择工作表范围

java - Apache POI - 创建单元格,在单个命令中设置单元格值和单元格样式