PDA

View Full Version : Change default mailbox in Outlook using MailEnvelope VBA



awbrown
05-01-2017, 12:47 PM
I'm attempting to send an email using MailEnvelope via MS Word and MS Outlook 2010, but I want to send it via a specific email account other than the default. I can send the email via default with no errors with "itm.send", but if I attempt to send it via "itm.SendUsingAccount" it errors with "Method 'SendUsingAccount' of object'_MailItem' failed". I also attempted to change from "itm As Object" to "itm As Outlook.MailItem", but this results in "item = nothing". Anyone know how to make this work?



Dim itm As Object
Dim ID As String
Set itm = objNurse_Employment_Intro_Email.MailEnvelope.Item
With itm
.To = (employ_fname & " " & employ_m_initial & " " & employ_lname)
.Subject = "Agreement"
.Attachments.Add Path_To_ftc_Fldr & Nurse_Agreement_File_To_Complete
.Save
ID = .EntryID
End With

' Set itm = Nothing

Set itm = applOutlook.Session.GetItemFromID(ID)

itm.SendUsingAccount = applOutlook.Session.Accounts.Item(3)

gmayor
05-01-2017, 11:33 PM
Frankly I wouldn't do it that way. The following will work if you substitute the correct attachment path and recipient e-mail address
Note that this requires the function indicated to open Outlook.


Sub Send_As_HTML_EMail()
'Graham Mayor - http://www.gmayor.com - Last updated - 02/05/2017
'Requires the OutlookApp function from
'Ben Clothier - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'To open Outlook correctly
Dim olApp As Object
Dim oItem As Object
Dim oRng As Range
Dim objDoc As Object
Dim objSel As Selection
On Error Resume Next
Set oRng = ActiveDocument.Range
oRng.Copy
Set olApp = OutlookApp()
'Create a new mailitem
Set oItem = olApp.CreateItem(0)
With oItem
.BodyFormat = 2
.Display
Set objDoc = .GetInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
objSel.Paste
.to = "someone@somewhere.com"
.Subject = "Agreement"
.Attachments.Add "C:\Path\Example.docx"
.SendUsingAccount olApp.session.accounts.Item(3)
'.Send 'Restore after testing
End With
lbl_Exit:
'Clean up
Set oItem = Nothing
Set olApp = Nothing
Set oRng = Nothing
Set objDoc = Nothing
Set objSel = Nothing
Exit Sub
End Sub