Sending an Outlook Email Created from Excel VBA

[Hobolord]

Hello,

I am working with Excel 2013 & Outlook 2013 on Windows 7 on a PC.


I adopted a macro from a co-worker which creates an email. The code is shown below. He was using .Display to just open the window of the email and then he manually clicked send on each email. I really don't want to have to do that for all 300 emails, and the macro bugs once it reaches a certain about anyway.

I tried commenting the .Display and adding .Send but it hits a runtime error at the .Send now...

"Run-time error '-2147219712 (80040700)':

The operation failed. The messaging interfaces have returned an unknown error. If the problem persists, restart Outlook. Cannot resolve recipient."

Like I said, it worked fine with the .Display, and i restarted Outlook several times to no avail.

Please help.

Sub Step4()


Dim MYOUTLOOK As Object
    Dim MYMESSAGE As Object
    Dim email As String
    Dim MyPath As String
    Dim strFilename As String
    Dim wsSrc As Worksheet


    
    Vtime = Format(Now(), "(mm-dd-yyyy)")
    MyPath = "C:\Documents and Settings\cbs1715\My Documents\Recipients"
    strFilename = Dir(MyPath & "\*.xlsx", vbNormal)
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
  Do Until Len(strFilename) = 0
  
  Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
  
    email = Sheets("Statement").Range("T2").Value
     
    
      Set MYOUTLOOK = CreateObject("Outlook.Application")
       Set MYMESSAGE = MYOUTLOOK.CreateItem(olMailItem)
           With MYMESSAGE
           .SentOnBehalfOfName = "Joe Smith"
           .To = email
           .Subject = "February 2016" & " " & Vtime
           .Body = "Unimportant Detail"
           .Attachments.Add ActiveWorkbook.FullName
           .ReadReceiptRequested = False
           '.Display
           .Send
           End With
           
           ActiveWorkbook.Close
           Application.DisplayAlerts = False
       Set MYOUTLOOK = Nothing
       Set MYMESSAGE = Nothing


strFilename = Dir()


Loop
        
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True


MsgBox "E-mails successfully sent!"


End Sub

Thank you,

Hobo

 

[DaveBlakeMAAT]

I think sent OnBehalfOf should be an email address, i.e. a generic email account, try commenting out that line and test it, using outlook's default account

 

[Hobolord]

Wow! I feel so dumb... That was it. I switched the .SentOnBehalfOfName to an email address and it worked. Thanks so much Dave! I was going insane!

 

[DaveBlakeMAAT]

You are welcome, have recently completed a similar project to this myself.

 

[AOB]

I think sent OnBehalfOf should be an email address, i.e. a generic email account, try commenting out that line and test it, using outlook's default account

Just wanted to post that I was having a similar problem and could not figure out why - was using the DisplayName rather than the SMTP Address - recipients were resolving fine and could send the resulting drafts manually with no issue, error only arose when releasing the drafts via code. Rebuilt Outlook profiles, refreshed the locally cached GAL, nothing made any difference.

Switching the DisplayName for the SMTP Address solved everything (better unique identifier anyway, old code written by poorly-informed me...)

Love to know how VBA can "tell" whether the recipient was originally added via address rather than DN, given that I force the recipients to resolve after adding them but before trying to send them, with a handler to catch if they don't resolve for whatever reason. The resulting drafts therefore look exactly the same with both methods (but only send sans error with one of them)

Anyway - thanks for this, saved me a LOT of time!