Send automated e-mails from Excel to Outlook

[tiredofit]

I have some standard code in Excel which instructs Outlook to send e-mails.

Sometimes the program runs all the way to the end with no problems but at other times, it crashes.

These are the lines of code in question:

    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    
    Dim objMail As Object
    Set objMail = objOutlook.CreateItem(0)

It crashes on this line:

Set objMail = objOutlook.CreateItem(0)

with the error message:

run time error 462 the remote server machine does not exist or is unreachable

but when I drag the cursor back to this line:

Set objOutlook = CreateObject("Outlook.Application")

and press run, the program continues without any problems.

What coudl be the problem and how might I be abke to fix it?

Thanks

 

[ranman256]

usage:
Sent1Email "coyote@acme.com", "your order", "here is the subject"

'NOTE : YOU MUST HAVE THE OUTLOOK REFERENCE CHECKED IN VBE; Alt-F11, menu,tools, references, Microsoft Outlook XX Object library

Public Function Send1Email(ByVal pvTo, ByVal pvSubj, ByVal pvBody, Optional ByVal pvFile) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem

On Error GoTo ErrMail

Set oApp = CreateObject("Outlook.Application")  'not this
Set oMail = oApp.CreateItem(olMailItem)

With oMail
    .To = pvTo
    .Subject = pvSubj
    If Not IsMissing(pvFile) Then .Attachments.Add pvFile, olByValue, 1
    
    .HTMLBody = pvBody
    'If Not IsNull(pvBody) Then .Body = pvBody
    
    .Display True   'show user but dont send yet
    '.Send          'send now
End With

Send1Email = True
Endit:
Set oMail = Nothing
Set oApp = Nothing
Exit Function

ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Endit
DoCmd.OutputTo acOutputReport, "rMyReport", acFormatPDF, vFile

End Function

 

[tiredofit]

usage:
Sent1Email "coyote@acme.com", "your order", "here is the subject"

'NOTE : YOU MUST HAVE THE OUTLOOK REFERENCE CHECKED IN VBE; Alt-F11, menu,tools, references, Microsoft Outlook XX Object library

Public Function Send1Email(ByVal pvTo, ByVal pvSubj, ByVal pvBody, Optional ByVal pvFile) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem

On Error GoTo ErrMail

Set oApp = CreateObject("Outlook.Application")  'not this
Set oMail = oApp.CreateItem(olMailItem)

With oMail
    .To = pvTo
    .Subject = pvSubj
    If Not IsMissing(pvFile) Then .Attachments.Add pvFile, olByValue, 1
   
    .HTMLBody = pvBody
    'If Not IsNull(pvBody) Then .Body = pvBody
   
    .Display True   'show user but dont send yet
    '.Send          'send now
End With

Send1Email = True
Endit:
Set oMail = Nothing
Set oApp = Nothing
Exit Function

ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Endit
DoCmd.OutputTo acOutputReport, "rMyReport", acFormatPDF, vFile

End Function

Thanks for the code.

I added a pause in mine and so far, it hasn't crashed.

    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
 
    Application.Wait (Now + TimeValue("00:00:01"))
  
    Dim objMail As Object
    Set objMail = objOutlook.CreateItem(0)
    
    Application.Wait (Now + TimeValue("00:00:01"))