sharky12345
Well-known Member
- Joined
- Aug 5, 2010
- Messages
- 3,404
- Office Version
- 2016
- Platform
- Windows
I'm using this to create an email when an error occurs;
Is there a way I could attach the current workbook to that message so that I also get a copy of the file they're working on?
Code:
Private Sub ErrorMessage(ErrNo As Long, ErrLine As Long, strDescription As String, Optional strComment As String, Optional strSource As String, Optional strProcedure As String, Optional bReportError As Boolean = True, Optional strExtendedErrInfo As String = "")
Const cstrError As String = "Error"
Dim strOfficeApplication As String
Dim strDocument As String
Dim strErrorTitle As String
Dim strMessage As String
Dim strMessage2 As String
Dim strSubject As String
On Error Resume Next
If Len(strComment) > 0 Then strComment = vbCrLf & vbCrLf & strComment
If Len(strProcedure) > 0 Or Len(strSource) > 0 Then strProcedure = strProcedure
Dim app As Object: Set app = Application
strOfficeApplication = app.Name & " (" & app.Version & ")"
Select Case app.Name
Case "Microsoft Excel"
strDocument = app.ThisWorkbook.Name
Case "Microsoft Access"
strDocument = app.CodeProject.Name
End Select
If bReportError = True Then
strErrorTitle = ThisWorkbook.BuiltinDocumentProperties("Title") & " - Debug Error Report"
strMessage = cstrError
End If
strMessage = "An error has occurred, details of which are below: " & vbCrLf & vbCrLf & strMessage & _
" " & ErrNo & ": " & strDescription & " " & strProcedure & " line " & ErrLine & " " & strComment
strMessage2 = "Error: " & ErrNo & vbCrLf & "Description: " & strDescription & vbCrLf & "Module: " & strProcedure & vbCrLf & "Line: " & ErrLine & " " & strComment
If bReportError = False Then
MsgBox strMessage, vbCritical, strErrorTitle
Else
Dim iPos As Long
iPos = InStr(strMessage, "@")
If iPos > 0 Then strMessage = Left(strMessage, iPos - 1)
Dim lngRet As Long
Dim strMsg As String
strMsg = "Support Information:" & _
vbCrLf & vbCrLf & strMessage2 & vbCrLf & "Software Title: " & ThisWorkbook.BuiltinDocumentProperties("Title") & vbCrLf & _
ThisWorkbook.BuiltinDocumentProperties("Comments") & vbCrLf & "File Name: " & strDocument & vbCrLf & _
"Windows Version: " & WindowsVersion & vbCrLf & "Office Version: " & strOfficeApplication & vbCrLf & strExtendedErrInfo
If CheckForOLEMessaging() = True Then
If (vbYes = MsgBox(strMessage & vbCrLf & vbCrLf & "Please click Yes to report the problem or No to ignore - error recovery " & _
"will attempt to continue the process regardless of your choice", vbYesNo + vbCritical + vbDefaultButton2, strErrorTitle)) Then
Send AddressTo, strErrorTitle, strMsg
End If
Else
Dim strReportFile As String
Dim intFn As Long
strReportFile = DirTemporary() & "~" & Format(Now, "YYYYMMDDHHNNSS") & ".txt"
intFn = FreeFile
Open strReportFile For Output Access Write As #intFn
Print #intFn, strMsg
Close #intFn
Shell "notepad.exe """ & strReportFile & """"
Kill strReportFile
End If
End If
End Sub
Is there a way I could attach the current workbook to that message so that I also get a copy of the file they're working on?