Excel 2016 VBA to send email - old VBA (Excel 2010 no longer works)

[Spewtress]

Application - Excel 2016 & Outlook 2016

My OLD MACRO code worked fine in Excel 2010, now we have been upgraded to Office 365 (2016), and my coding debugs at the ".send" command. Run-time error '287': Application-defined or object-defined error" and the .send is highlighted in yellow.

I was able to find updated coding at" https://www.rondebruin.nl/win/s1/outlook/mail.htm". Using Rondebruin coding guidance (New macro), it kinda works, meaning if I end with .display, the email appears and we can manually hit send. But if I add to the next line or change the coding to .send, the macro finishes but NO email sends and it does NOT debug. We have to many emails and to many reports to manually hit send after each email. I can use this macro as a TEMPORARY fix, but can not have permanently. We run multiple reports by running macro's. The last part of EVERY macro sends an email to a set group of staff one report sends to over 100+ individual emails, to alert them the report is ready to work, and the reports link.

In my research it sounds like a security setting in our company's 2016 outlook. I do not have access to deactivate this setting, so if this is true, I need it built into the coding. I need help with a simplified code.

OLD Macro
Dim OutApp As Object
Dim OutMail As Object
Const SendTo As String = "your email address"
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = [email protected]
.Subject = ActiveWorkbook.Name & " " & "report is ready for your review"
.Body = "The PP" & " " & FName & " " & "A1-280 report is available Please research your accounts take action." _
& vbNewLine & vbNewLine & _
"<\\VP0SENTSHRCMN03\Common2\PPS\PP\ODN\BRANCH\Insurance Unit\Reports\FEGLI A1 280 Yearly Reports>"
.Send

End With
Set OutMail = Nothing
Set OutApp = Nothing

NEW macro
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "" & _
"The PP" & " " & FName & " " & "Comp NOA report is now available in the shared directory. Please take action. " & _
"Click on this link to open the file : " & _
"file://VP0SENTSHRCMN03\Common2\PPS\PP\ODN\BRANCH\Insurance Unit\Yearly Reports" & _
""">//VP0SENTSHRCMN03\Common2\PPS\PP\ODN\BRANCH\Insurance Unit\Yearly Reports"
On Error Resume Next
With OutMail
.To = "[email protected]; [email protected]"
.CC = ""
.BCC = ""
.Subject = ActiveWorkbook.Name & " " & "report is ready for your review"
.HTMLBody = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If

[LJMetzger]

Hi Spewtress,

There should not be anything wrong with your code. I did not have any problems with the code when moving from 2010 to 2016. I did have a problem with .Send that required a setting in Outlook. I think this only happened when I tried to send more than one email, but I am not sure.

However, in Office 2016 I had to update a setting in Outlook.
To prevent OutLook Security Message such as (and to remain secure):
a. A program is trying to send an e-mail message on your behalf, or
b. A program is trying to access e-mail addresses:
Make sure Anti-Virus software is up to date
Go to Windows 'Start' Menu
Right Click on 'Outlook 2016' and select 'Run as Administrator' (i.e. Run Outlook as Administrator)
File > Options > Trust Center > Trust Center Settings > Programmatic Access
AntiVirus status : Valid' should be displayed in the middle of the Screen.

I don't recall having runtime error 287 however. Someone else had the same error as you because Outlook was not open. Your code does not do any error checking to make sure the 'Outlook object' is valid. Try starting your macro something like:

Sub SimpleOutlookEmailDiplayWithTextColor()
  'This assumes that Outlook is already open to simplify the code
  
  Dim OutApp As Object
  Dim OutMail As Object
  
  
 'Attempt to create an Outlook object
  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
    Err.Clear
    msgbox "NOTHING DONE.  The Outlook Object could not be created from Excel." & vbCrLf & _
           "Try again when Outlook is open."
    Exit Sub
  End If
  On Error GoTo 0
  
  
  'Create the Outlook Mail Object (using the default Email account)
  Set OutMail = OutApp.CreateItem(0)
 
  '''''
  'Remainder of code omitted

I hope this helps.

Lewis

[LJMetzger]

To get the Outlook object whether Outlook is open or closed, I use code like the following:

Option Explicit

'SetForegroundWindow() is used by MoveFocusToWorksheet()
#If VBA7 And Win64 Then
    '64 bit Excel:
    'All of the Win64 lines are supposed to be RED in 32 bit Excel
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long

#Else
    '32 bit Excel:
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

#End If

'Outlook enumeration constant reference: https://msdn.microsoft.com/en-us/library/office/aa219371(v=office.11).aspx
Private Const olMinimized As Long = 1
Private Const olMaximized As Long = 2
Private Const olFolderInbox As Long = 6

Sub TestGetOutlookObject()

  Dim OutApp As Object

 'Get the Outlook Object if Outlook is already open
  On Error Resume Next
  Set OutApp = LjmOpenOutlook()
  
  'Exit if the Outlook Object could not be created
  If OutApp Is Nothing Then
    MsgBox "NOTHING DONE.  Outlook could not be opened."
    GoTo MYEXIT
  End If
  
  Call MoveFocusToWorksheet(ActiveSheet)
  MsgBox "Outlook Object was successfully obtained."
  
MYEXIT:
  'Clear object pointers
  Set OutApp = Nothing

End Sub

Function LjmOpenOutlook( _
    Optional iWindowState As Long = olMinimized, _
    Optional bReleaseIt As Boolean = False _
    ) As Object
  'This opens outlook if it is NOT already open
  'Reference: http://www.rondebruin.nl/win/s1/outlook/openclose.htm
  'Thank you Ron deBruin and Ben Clothier
  '
  'Late Binding is used in the following routines
  
  Static myStaticOutlookObject As Object
  
  On Error GoTo ERROR_HANDLER
 
  Select Case True
        
    Case myStaticOutlookObject Is Nothing, Len(myStaticOutlookObject.Name) = 0
      Set myStaticOutlookObject = GetObject(, "Outlook.Application")
      If myStaticOutlookObject.Explorers.Count = 0 Then
INIT_OUTLOOK:
        'Open the Outlook inbox to prevent errors with security prompts
        'Set the requested Outlook Windows state (i.e. Minimized, Maximized)
        myStaticOutlookObject.Session.GetDefaultFolder(olFolderInbox).display
        myStaticOutlookObject.ActiveExplorer.WindowState = iWindowState
      End If
        
    Case bReleaseIt
      'Clear the STATIC Outlook Object if requested by the input option
      Set myStaticOutlookObject = Nothing
      
  End Select
    
  'Set the return value
  Set LjmOpenOutlook = myStaticOutlookObject
  GoTo MYEXIT

ERROR_HANDLER:
 Select Case Err.Number
    Case -2147352567
      'User cancelled setup, silently exit
      Set myStaticOutlookObject = Nothing
    Case 429, 462
      'Error 462 - Outlook is NOT open
      Set myStaticOutlookObject = GetOutlookApp()
      If myStaticOutlookObject Is Nothing Then
        Err.Raise 429, "LjmOpenOutlook", "Outlook Application does not appear to be installed."
      Else
        Resume INIT_OUTLOOK
      End If
    Case Else
      MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error attempting to OPen Outlook."
  End Select
    
MYEXIT:
  Exit Function
      
End Function

Private Function GetOutlookApp() As Object
  'This returns a pointer to the Outlook Object if Outlook is available
  '
  'This function is used exclusively by LjmOpenOutlook() and is part of the
  'original Ron deBruin code referenced above
  
  Dim myOutlookObject As Object

  'Attempt to create an Outlook object
  On Error Resume Next
  Set myOutlookObject = CreateObject("Outlook.Application")
  On Error GoTo 0
    
  'Clear any error that occurs and also clear the object
  If Err.Number <> 0 Then
    Err.Clear
    Set myOutlookObject = Nothing
  End If
  
  'Set the return value
  Set GetOutlookApp = myOutlookObject

  'Clear the local object pointer
  Set myOutlookObject = Nothing

End Function

Sub MoveFocusToWorksheet(ws As Worksheet)
  'This moves the focus from another application (e.g. Outlook) back to Excel
  '
  'Reference: http://stackoverflow.com/questions/28042521/set-focus-back-to-the-application-window-after-showing-userform
  'Thank you Gene Skuratovsky
  
  'Put the focus on the Workbook and Worksheet from the input parameter
  ws.Parent.Activate
  ws.Activate
  
  'Move the above Workbook/Worksheet to the front
  Call SetForegroundWindow(Application.hwnd)
    
End Sub

It is a best practice to declare all variables. If you misspell a variable in your code, VBA will silently assume it is a Variant variable and go on executing with no clue to you that you have a bug. Go to the VBA development window, click Tools, Options, and check "Require Variable Declaration." This will insert the following line at the top of all new modules:

Option Explicit

This option requires all variables to be declared and will give a compiler error for undeclared variables.

Lewis

[LJMetzger]

Reply deleted by LJMetzger - duplicate post in error.

[Spewtress]

I always have outlook open before any reports, since we receive our report by outlook. Then we run the macro and it lets staff know it is ready to work.

[LJMetzger]

You should probably change:

Set OutApp = CreateObject("Outlook.Application")

to:

 'Attempt to create an Outlook object
  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
    Err.Clear
    msgbox "NOTHING DONE.  The Outlook Object could not be created from Excel." & vbCrLf & _
           "Try again when Outlook is open."
    Exit Sub
  End If
  On Error GoTo 0

Note the comma before "Outlook.Application".