我正在使用以下错误处理方法来保存当前打开的文件的副本,如果它导致错误,则将其发送到我的电子邮件。
Private Declare Function GetTempPath _
Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Sub MainSub()
Dim OutApp As Object, OutMail As Object
Dim wb As Workbook
On Error GoTo NotifyandRepair
Call Sub1
Call Sub2
Call Subn
Exit Sub
NotifyandRepair:
Set wb = ThisWorkbook
Application.DisplayAlerts = False
wb.SaveAs TempPath & "ErroringFile.xlsx", FileFormat:= _xlNormal,AccessMode:=xlExclusive,ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "name@company.com"
.Subject = "Error Occured - Error Number " & Err.Number
.Body = Err.Description
.Attachments.Add TempPath & "ErroringFile.xlsx"
.Send '~~> Change this to .Display for displaying the email
End With
Set OutApp = Nothing: Set OutMail = Nothing
End Sub
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
似乎工作正常。当发生未处理的错误时,它会向我发送该文件的副本,并将其重命名为“ErroringFile.xlsx”。问题是文件总是损坏。
我做错了吗?
如何解决此问题,以免文件损坏?