Attach file to error reporting message

[sharky12345]

I'm using this to create an email when an error occurs;

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?

 

[CharlesChuckieCharles]

Just a point

If the code/workbook is in error how certain are you that you can continue to fire an email out ?

 

[sharky12345]

I don't know enough about it to fully understand it, all I do know is that it works by adding these at the start and end of each routine;

On Error GoTo HandleError

Exit Sub
HandleError:
ErrorHandle Err, Erl(), "CommandButton3_Click - AdviceFrm"
Resume Next