Error 2051 - Cancel SendObject

[ShredDude]

I can't seem to successfully deal with this error.

The scenario is as follows. I click a button which launches an email with an attachment, with the option of having the User see it first. That works fine.

If the user chooses to not send the email however, and hits the email's close button to Cancel the send, I get Error 2051 popping up in Access.

I built code to trap the error, but it only works the first time through. For example, If i launch the email and cancel it, the following code kicks in, the user sees the MsgBox regarding the error, and the sub exits gracefully. But if you then try to send the email again, and cancel again, my error code does not get hit, and Access throws up a window saying the SendObject method was canceled. When you click OK, Access is frozen, VBA Editor is frozen. I can't do anything but hear an annoying beep sound every time I click anywhere. CTRL+Break doesn't get me into VBA. I can't get to the Immediate window in the VBA Editor. The only way I've found out of it is to use Task Manager to shut down Access.

On Error GoTo errHandler
    DoCmd.SendObject acSendForm, "frmemailscenarios", acFormatPDF, strTo, , , strSubject, strBody
 
ExitErr:

Exit Sub

errHandler:

MsgBox "You hit Error # : " & Err & vbCrLf & _
    Err.Description
Resume ExitErr


End Sub

I've read some other posts regarding an apparent inability to trap this error.

Does anyone have any ideas? Is there a way to detect this "frozen" state I describe and get out of that, as a work around?

 

[darbid]

Hello Shreddude, I am a learner, and thus know what it is like not to get an answer. So I thought I would give it a go at helping you.

First I do not use the SendObject but I had a similar problem with deleting records. You get a similar error if you have

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

and the user says no to confirm deleting. Instead of trying to capture the error message and deal with it, people here on the forum simple have a msgbox question confirming the deletion which then runs the above code. Maybe you could do the same for send email.

As an alternative you may want to use your other office programs as I do for email.

I actually turned emails into a function. Remember I am a beginner so this may not be the best way of doing this.

I then use

Call sendmessage(here I add the required variables)

Public Function SendMessage(strTo, strSubject, STRBodyMessage As String, _
Optional AttachmentPath As String, Optional AttachmentPosition As Integer, _
Optional AttachmentName As String, Optional CC As String, Optional strBCC As String, Optional EnglishSignature As Boolean)

Dim msgOutlook As Outlook.MailItem
Dim appOutlook As Outlook.Application
Dim expOutlook As Outlook.Explorer
Dim insOutlook As Outlook.Inspector
Dim sigstring As String
Dim Signature As String
Dim ThePath As String
Dim TheFilePart As String


On Error GoTo ErrorHandler
   
'Set Application variable using GetObject; error handler falls back to CreateObject if Outlook is not open
Set appOutlook = GetObject(, "Outlook.Application")
Set msgOutlook = appOutlook.CreateItem(olMailItem)
Set insOutlook = msgOutlook.GetInspector
    

ThePath = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\"

If EnglishSignature Then
    TheFilePart = ProfileGetItem("Email", "sigpartfileEN", sDefValue, sInifile) & "*.txt"
Else
    If strlanguage = "DE" Then
        TheFilePart = ProfileGetItem("Email", "sigpartfileDE", sDefValue, sInifile) & "*.txt"
    Else
        TheFilePart = ProfileGetItem("Email", "sigpartfileEN", sDefValue, sInifile) & "*.txt"
    End If
End If

If Dir(sigstring) <> "" Then
    Signature = GetSIG(ThePath, TheFilePart)
Else
    Signature = ""
End If

With msgOutlook
    If Len(AttachmentPath) > 0 Then
    .Save
    .Attachments.Add AttachmentPath, olByValue, AttachmentPosition, AttachmentName
    End If
    .BodyFormat = olFormatRichText
    .Subject = strSubject
    .To = strTo
    .Body = STRBodyMessage & vbCr & Signature
    .Display
End With
    
insOutlook.Activate
insOutlook.Display


Set msgOutlook = Nothing
Set appOutlook = Nothing
Set expOutlook = Nothing
Set expOutlook = Nothing
       
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   
   Select Case Err
   
    Case 429
'Outlook is not running; open Outlook with CreateObject
      Set appOutlook = CreateObject("Outlook.Application")
      Resume Next
   Case 53
   MsgBox ProfileGetItem(strlanguage, "emailsignotfound", sDefValue, sInifile), vbExclamation, "Signature Missing"
   Resume Next
   Case Else
      MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
      Resume ErrorHandlerExit
   End Select
   
End Function

Please note that I have allowed for special signatures but if you simply delete that part you should be ok. Also I get some information from an ini file (ProfileGetItem) these parts you should ignore as well.

Function GetSIG(ByRef ThePath As String, TheFilePart As String) As String

Dim fso As Object
Dim ts As Object
Dim TheFile As String

TheFile = Dir(ThePath & TheFilePart)

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(ThePath & TheFile).OpenAsTextStream(1, -2)
GetSIG = ts.ReadAll
ts.Close

End Function

I hope that gives you two alternatives.