CODEWITHSUNDEEP
vbaemailoutlookoutlook-2010
foobarbaz
foobarbaz

Reputation: 322

How to wait until e-mail is sent and window is closed in Outlook VBA?

My VBA code opens an e-mail template and should copy the email content into an appointment after editing and sending the e-mail.

The problem is that the appointment opens before the e-mail is sent, and the unedited e-mail content is inserted into the appointment. (if I remove the while loop)

How can I wait for sending the e-mail and closing its window?

Error: Outlook freezes or it displays the error:

runtime error '-2147221238 (8004010a)': element moved....

Public Sub Fooo()
Dim items As Outlook.items
Dim Item As Object

Set items = Application.ActiveExplorer.CurrentFolder.items

Set Item = items.Add("IPM.Note.My Template Mail")
Item.SentOnBehalfOfName = "[email protected]"
Item.Display

While Item.Sent = False
Wend

CreateAppointment MyMail:=Item

End Sub

Upvotes: 4

Views: 4673

Answers (2)

R3uK
R3uK

Reputation: 14537

You'll have to modify a bit your CreateAppointment sub,
but use a variable to store the content of the mail before sending it and then pass it to your sub!

Public Sub Fooo()
Dim items As Outlook.items
Dim Item As Object
Dim ItmContent As String

Set items = Application.ActiveExplorer.CurrentFolder.items

Set Item = items.Add("IPM.Note.My Template Mail")

With Item
    .SentOnBehalfOfName = "[email protected]"
    .Display True

    Do
        ItmContent = .Body 'Or other property that you use in CreateAppointment
        DoEvents
    Loop Until Item Is Nothing
End With 'Item

CreateAppointment ItmContent

End Sub

Working solution with error handling :

Public Sub Fooo()
Dim items As Outlook.items
Dim Item As Object
Dim ItmContent As String

Set items = Application.ActiveExplorer.CurrentFolder.items

Set Item = items.Add("IPM.Note.My Template Mail")

Item.SentOnBehalfOfName = "[email protected]"
Item.Display

On Error GoTo MailSent
    Do
        ItmContent = Item.Body 'Or other property that you use in CreateAppointment
        DoEvents
    Loop Until Item Is Nothing
On Error GoTo 0


DoEvents
AfterSend:
    'Debug.Print ItmContent
    CreateAppointment ItmContent
    Exit Sub
MailSent:
    If Err.Number <> -2147221238 Then
        Debug.Print Err.Number & vbCrLf & Err.Description
        Exit Sub
    Else
        Resume AfterSend
    End If
End Sub

Upvotes: 1

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66215

Wait for the Items.ItemAdd event to fire on the Sent Items folder and only then create the new appointment.

Upvotes: 2

Related Questions