Userform Attach Item to Email: Runtime Error(s)

[Qwest336]

Hello all...

I have a Userform Module that calls GetOpenFilename to attach a file to an email. I used the following two subs to do that:

Private Sub cmdRescAttach_Click()
'The following code is for designating an attachment from the user's computer. Works in conjunction with Attachment.Add method in Outmail.
Dim strFileName As Variant
 
    ChDir "C:\" ' change to path to start dialog in
    
    strFileName = Application.GetOpenFilename(, , "Choose file for Escalation", , False)
    
    If TypeName(strFileName) = "String" Then
        tbRescDocAttached.Value = strFileName
    Else
        MsgBox "No attachment selected"
    End If

 End Sub

        .Attachments.Add EscalationsForm.tbRescDocAttached.Value & EscalationsForm.tbUHADocAttached.Value & EscalationsForm.tbRSCDocAttached.Value
        
    If tbRescDocAttached.Value <> "" Then
            .Attach tbRescDocAttached.Value
    ElseIf tbUHADocAttached.Value <> "" Then
            .Attach tbUHADocAttached.Value
    ElseIf tbRSCDocAttached.Value <> "" Then
            .Attach tbRSCDocAttached.Value
    End If
    End With

Now, it seems to work locally as, when I put the item in Display mode, the email shows with the attachment. However, when I put the form into Send mode, I get the following Run-time error:

(Not sure if it is going to display)

"Run-time error '-2147221238 (8004010a)': The item has been moved or deleted."

The Error is breaking on the Attachments.Add property. However, when I add a breakpoint and hover, it does display the path to the selected document. Due to error-handling, the email does send but the attachment is not included.

In display mode, I get a Run-time 438 error message (Object doesn't support this property or method)on the If Else statement. However, again, the item does show as attached.

Does anyone have any suggestions for this? Any help is, as always, greatly appreciated!

 

[John_w]

An educated guess:

    If tbRescDocAttached.Value <> "" Then
            .Attachments.Add tbRescDocAttached.Value
    ElseIf tbUHADocAttached.Value <> "" Then
            .Attachments.Add tbUHADocAttached.Value
    ElseIf tbRSCDocAttached.Value <> "" Then
            .Attachments.Add tbRSCDocAttached.Value
    End If
    End With

 

[Qwest336]

Good morning John...thanks for the response!

I made that change today, and ran the form in Send mode and it still gave me the same runtime error.

"Run-time error '-2147221238 (8004010a)': The item has been moved or deleted."

It also broke on the same line:

.Attachments.Add EscalationsForm.tbRescDocAttached.Value & EscalationsForm.tbUHADocAttached.Value & EscalationsForm.tbRSCDocAttached.Value

As before, the email completed but the attachment was missing. Any additional ideas?

An educated guess:

    If tbRescDocAttached.Value <> "" Then
            .Attachments.Add tbRescDocAttached.Value
    ElseIf tbUHADocAttached.Value <> "" Then
            .Attachments.Add tbUHADocAttached.Value
    ElseIf tbRSCDocAttached.Value <> "" Then
            .Attachments.Add tbRSCDocAttached.Value
    End If
    End With

 

[John_w]

It also broke on the same line:

.Attachments.Add EscalationsForm.tbRescDocAttached.Value & EscalationsForm.tbUHADocAttached.Value & EscalationsForm.tbRSCDocAttached.Value

No, delete that line.

 

[Qwest336]

Thanks again for the response.

So, I commented out that line and left your changes the same. The form sent without a runtime error. However, there still was not an email attachment present.

No, delete that line.

 

[John_w]

I've tried to reproduce the problem with the file not being attached to the Outlook email, but all my tests have been successful.

Try using the routine below (called via a command button named "cmdSend" on the userform) to send/display the email:

Private Sub cmdSend_Click()

    Dim OutApp As Object 'Outlook.Application
    Dim OutMail As Object 'Outlook.MailItem

    Set OutApp = CreateObject("Outlook.Application") 'New Outlook.Application

    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "an.email@address.com"  'CHANGE THIS TO A VALID EMAIL ADDRESS
        .Subject = "Subject here"
        .Body = "Email body text."
        
        If tbRescDocAttached.Value <> "" Then
            If Dir(tbRescDocAttached.Value, vbNormal) = "" Then MsgBox tbRescDocAttached.Value & " does not exist"
            .Attachments.Add tbRescDocAttached.Value
        ElseIf tbUHADocAttached.Value <> "" Then
            .Attachments.Add tbUHADocAttached.Value
        ElseIf tbRSCDocAttached.Value <> "" Then
            .Attachments.Add tbRSCDocAttached.Value
        End If

        .Send
        '.Display
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

 

[Qwest336]

Wow...I have no idea why, but that worked. I'm going to try to edit the sub to include the formatting of the email and the other things that the coding does prior to sending and test again. Thanks for this! I'll let you know if it works after the additions!

I've tried to reproduce the problem with the file not being attached to the Outlook email, but all my tests have been successful.

Try using the routine below (called via a command button named "cmdSend" on the userform) to send/display the email:

Private Sub cmdSend_Click()

    Dim OutApp As Object 'Outlook.Application
    Dim OutMail As Object 'Outlook.MailItem

    Set OutApp = CreateObject("Outlook.Application") 'New Outlook.Application

    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "an.email@address.com"  'CHANGE THIS TO A VALID EMAIL ADDRESS
        .Subject = "Subject here"
        .Body = "Email body text."
        
        If tbRescDocAttached.Value <> "" Then
            If Dir(tbRescDocAttached.Value, vbNormal) = "" Then MsgBox tbRescDocAttached.Value & " does not exist"
            .Attachments.Add tbRescDocAttached.Value
        ElseIf tbUHADocAttached.Value <> "" Then
            .Attachments.Add tbUHADocAttached.Value
        ElseIf tbRSCDocAttached.Value <> "" Then
            .Attachments.Add tbRSCDocAttached.Value
        End If

        .Send
        '.Display
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

 

[Qwest336]

John_w....you are a life saver!!

Thank you so much. I integrated your If statement into the With Outmail Statement, adding the If Dir check into all three ElseIf conditions and, IT WORKED!

I appreciate your help a ton! I've learned a bunch from this site and, at some point, I'll have a second to pour through it and find out why it fixed the issue. But this solves an immediate issue that I had to get taken care of. Thanks so much for your time, effort, and knowledge!

Wow...I have no idea why, but that worked. I'm going to try to edit the sub to include the formatting of the email and the other things that the coding does prior to sending and test again. Thanks for this! I'll let you know if it works after the additions!

 

[John_w]

Thank you so much. I integrated your If statement into the With Outmail Statement, adding the If Dir check into all three ElseIf conditions and, IT WORKED!

Thanks for the feedback.

The Dir function call would not cause the code to work, so it must be another part of your code. Dir simply checks whether a file exists, however the correct code should be:

        If tbRescDocAttached.Value <> "" Then
            If Dir(tbRescDocAttached.Value, vbNormal) = "" Then 
                MsgBox tbRescDocAttached.Value & " does not exist"
            Else
                .Attachments.Add tbRescDocAttached.Value
            End If
        ElseIf tbUHADocAttached.Value <> "" Then
            .Attachments.Add tbUHADocAttached.Value
        ElseIf tbRSCDocAttached.Value <> "" Then
            .Attachments.Add tbRSCDocAttached.Value
        End If

and repeat the same structure for the ElseIf parts.