locked
Mail From Excel Using Outlook Error RRS feed

  • Question

  • Hello All,

    I am encountering an error on a system that I ported a Mail from Excel using Outlook program I wrote while reading an oMailItem property (.body).  This is confusing, because I can write to the property but cannot read from it which, as far as errors go, seems backwards.  I'm putting this out there for input but I believe this is an Office Macro Security setting issue which is managed by my IT department.

    Below is the offending procedure.  The error occurs when the sDefaultSignature variable attempts to read the oMailItem.Body property.  This is done as a means to capture the user's default Outlook signature and use that instead of an alternate one that is defined in the Excel workbook.  Perhaps there is another way to do that?

    Excuse the verbosity of some of the comments; this procedure is also used as a VBA training aid.

    Sub WriteMail(sToRecipients, sCCRecipients, sBCCRecipients, sBody, sSubject, sDefaultSignature) 'Sub opens a new mail message in outlook and builds

    'out the contents based on user input. 'Late Binding (Best for Distribution/Compatibility) Dim oOutlook, oMailItem As Object Set oOutlook = CreateObject("Outlook.Application") Set oMailItem = oOutlook.CreateItem(olMailItem) 'Early Binding (Best for Programming) 'Dim oOutlook As Outlook.Application 'Dim oMailItem As Outlook.MailItem 'Set oOutlook = New Outlook.Application 'Set oMailItem = oOutlook.CreateItem(olMailItem) With oMailItem 'Add Recipients .TO = sToRecipients .CC = sCCRecipients .BCC = sBCCRecipients On Error Resume Next .Recipients.ResolveAll 'May cause error depending on
    'security settings. Formats all e-mail
    'addresses as valid "mailto:" items. 'Set Subject .Subject = sSubject 'Mail Body Format .BodyFormat = olFormatHTML '(HTML = 2) 'Change Default Signature Block Prior to Sending Body as it would be
    'overwritten if User Opt'd to use their Default Outlook Sig.
    If UFrm_Email.CBox_ApplyUserSig = True Then On Error GoTo SignatureError: sDefaultSignature = .Body 'Throws an error depending on
    'security settings. End If Continue1: 'Apply Template Text and Chosen Signature .Body = sBody & vbCrLf & vbCrLf & sDefaultSignature 'Set Reply-To Recipients On Error GoTo ReplyToError: .ReplyRecipients.Add Range("Config_AlternateReplyTo") 'This can
    'cause an error
    'depending on
    'security settings. Continue2: 'Display Message .Display 'Send E-Mail Automatically (Disabled) '.Send End With 'This procedure is done. Destroy all objects to clear memory. Set oMailItem = Nothing Set oOutlook = Nothing Exit Sub 'If this is not here then the procedure will execute the error
    'handlers below even if there isn't an error! 'Error Handling SignatureError: MsgBox "Unable to apply user's default signature." & vbCrLf & _
    vbCrLf & "This is likely due to Excel's current Macro " & _
    Security Settings.", vbOKOnly, "Error" Resume Continue1 ReplyToError: MsgBox "Unable to apply alternate 'Reply To' address." & vbCrLf & _
    vbCrLf & "This is likely due to Excel's current Macro " & _
    Security Settings.", vbOKOnly, "Error" Resume Continue2 End Sub




    • Edited by Grasor Wednesday, November 23, 2016 4:47 PM
    • Moved by Chenchen Li Friday, November 25, 2016 6:25 AM Outlook
    Wednesday, November 23, 2016 4:42 PM

Answers

  • I assume that you are running the code from Excel? That being the case, you should create a new module and add Ben Clothier's function to open/get Outlook as Outlook doesn't always behave as expected when it is opened with CreateObject. The function is discussed at the link in the code below.

    Option Explicit
    'Ben Clothier - http://www.rondebruin.nl/win/s1/outlook'/openclose.htm
    #Const LateBind = True
    
    Const olMinimized As Long = 1
    Const olMaximized As Long = 2
    Const olFolderCalendar As Long = 9
    Const olFolderContacts As Long = 10
    Const olFolderDrafts As Long = 16
    Const olFolderInbox As Long = 6
    Const olFolderOutbox = 4
    Const olFolderSentMail = 5
    Const olFolderTasks = 13
    
    #If LateBind Then
    
    Public Function OutlookApp( _
           Optional WindowState As Long = olMinimized, _
           Optional Folder As Long = olFolderInbox, _
           Optional ReleaseIt As Boolean = False _
           ) As Object
    Static o As Object
    #Else
    Public Function OutlookApp( _
           Optional WindowState As Outlook.OlWindowState = olMinimized, _
           Optional Folder As Long = olFolderInbox, _
           Optional ReleaseIt As Boolean _
           ) As Outlook.Application
    Static o As Outlook.Application
    #End If
        On Error GoTo ErrHandler
    
        Select Case True
            Case o Is Nothing, Len(o.Name) = 0
                Set o = GetObject(, "Outlook.Application")
                If o.Explorers.Count = 0 Then
    InitOutlook:
                    'Open inbox to prevent errors with security prompts'
                    o.Session.GetDefaultFolder(Folder).display
                    o.ActiveExplorer.WindowState = WindowState
                End If
            Case ReleaseIt
                Set o = Nothing
        End Select
        Set OutlookApp = o
    
    ExitProc:
        Exit Function
    ErrHandler:
        Select Case Err.Number
            Case -2147352567
                'User cancelled setup, silently exit'
                Set o = Nothing
            Case 429, 462
                Set o = GetOutlookApp()
                If o Is Nothing Then
                    Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
                Else
                    Resume InitOutlook
                End If
            Case Else
                MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
        End Select
        Resume ExitProc
        Resume
    End Function
    
    #If LateBind Then
    Private Function GetOutlookApp() As Object
    #Else
    Private Function GetOutlookApp() As Outlook.Application
    #End If
        On Error GoTo ErrHandler
        Set GetOutlookApp = CreateObject("Outlook.Application")
    ExitProc:
        Exit Function
    ErrHandler:
        Select Case Err.Number
            Case Else
                'Do not raise any errors'
                Set GetOutlookApp = Nothing
        End Select
        Resume ExitProc
        Resume
    End Function

    Having done so you need to modify your code to use the Word Inspector to edit the message body. Then you don't have to faff around with the signatures. The default signature for the account will be included as a matter of course. I have added the relevant code to yours and included a simple test macro so that you can check that it works.

    Ensure that you leave the .Display command - even if you resurrect the .Send command of the message will not be created correctly. I have left your error handling untouched so that you can establish if it is still required.

    Option Explicit
    Sub TestMacro()
    WriteMail "someone@somewhere.com", "", "", "This is the message body text", "This is the subject"
    End Sub

    Sub WriteMail(sToRecipients As String, _
                  sCCRecipients As String, _
                  sBCCRecipients As String, _
                  sBody As String, _
                  sSubject As String)
    'Graham Mayor - http://www.gmayor.com - Last updated - 24/11/2016
    'Sub opens a new mail message in outlook and builds
    'out the contents based on user input.


    'Late Binding (Best for Distribution/Compatibility)
    Dim oOutlook As Object
    Dim oMailItem As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object

        On Error Resume Next
        'Use Ben Clothier's function to get Outloook - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
        Set oOutlook = OutlookApp()
        Set oMailItem = oOutlook.CreateItem(0) 'You must use the numeric equivalent with late binding

        With oMailItem
            'Add Recipients
            .TO = sToRecipients
            .CC = sCCRecipients
            .BCC = sBCCRecipients
            .Recipients.ResolveAll    'May cause error depending on
            'security settings.  Formats all e-mail
            'addresses as valid "mailto:" items.

            'Set Subject
            .Subject = sSubject

            'Mail Body Format
            .BodyFormat = 2 'You must use the numeric equivalent with late binding

            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.Collapse 1
            .display
            oRng.Text = sBody


    Continue1:

            On Error GoTo ReplyToError:
            .ReplyRecipients.Add Range("Config_AlternateReplyTo")    'This can
            'cause an error
            'depending on
            'security settings.

    Continue2:

            'Send E-Mail Automatically (Disabled)
            '.Send
        End With

        'This procedure is done.  Destroy all objects to clear memory.

        Set oMailItem = Nothing
        Set oOutlook = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub    'If this is not here then the procedure will execute the error
        'handlers below even if there isn't an error!


    ReplyToError:
        MsgBox "Unable to apply alternate 'Reply To' address." & vbCrLf & _
               vbCrLf & "This is likely due to Excel's current Macro " & _
               "Security Settings.", vbOKOnly, "Error"
        Resume Continue2
    End Sub




    Graham Mayor - Word MVP
    www.gmayor.com


    • Edited by Graham MayorMVP Thursday, November 24, 2016 1:00 PM
    • Marked as answer by Grasor Friday, November 25, 2016 12:39 PM
    Thursday, November 24, 2016 12:57 PM

All replies

  • Hi, 

    As far as I understood, you are trying to read the default signature from the Outlook new email body as soon as you open. In order to read it first you need to make sure that .Body  is visible. Therefore add .Display statement before reading the body and it will work.

    Sub WriteMail(sToRecipients, sCCRecipients, sBCCRecipients, sBody, sSubject, sDefaultSignature)
    
    'Sub opens a new mail message in outlook and builds 
    'out the contents based on user input.
    
    
    'Late Binding (Best for Distribution/Compatibility)
    Dim oOutlook, oMailItem As Object
    
    Set oOutlook = CreateObject("Outlook.Application")
    Set oMailItem = oOutlook.CreateItem(olMailItem)
    
    
    'Early Binding (Best for Programming)
    'Dim oOutlook As Outlook.Application
    'Dim oMailItem As Outlook.MailItem
    
    'Set oOutlook = New Outlook.Application
    'Set oMailItem = oOutlook.CreateItem(olMailItem)
    
    
    With oMailItem
     
        'Add Recipients
        .TO = sToRecipients
        .CC = sCCRecipients
        .BCC = sBCCRecipients
        On Error Resume Next
        .Recipients.ResolveAll 'May cause error depending on 
                               'security settings.  Formats all e-mail 
                               'addresses as valid "mailto:" items.
        
        'Set Subject
        .Subject = sSubject
        
        'Mail Body Format
        .BodyFormat = olFormatHTML '(HTML = 2)
        .display ' this will display before trying to read the body
        'Change Default Signature Block Prior to Sending Body as it would be
        'overwritten if User Opt'd to use their Default Outlook Sig.
    
        If UFrm_Email.CBox_ApplyUserSig = True Then
            On Error GoTo SignatureError:
            sDefaultSignature = .Body 'Throws an error depending on 
                                      'security settings.
        End If
        
    Continue1:
        
        'Apply Template Text and Chosen Signature
        .Body = sBody & vbCrLf & vbCrLf & sDefaultSignature
        
        'Set Reply-To Recipients
        On Error GoTo ReplyToError:
        .ReplyRecipients.Add Range("Config_AlternateReplyTo") 'This can 
                                                              'cause an error
                                                              'depending on 
                                                          'security settings.
        
    Continue2:
    
        'Display Message
        .Display
        
        'Send E-Mail Automatically (Disabled)
        '.Send
    End With
    
    'This procedure is done.  Destroy all objects to clear memory.
    
    Set oMailItem = Nothing
    Set oOutlook = Nothing
    
    Exit Sub 'If this is not here then the procedure will execute the error 
             'handlers below even if there isn't an error!
    
    'Error Handling
    SignatureError:
        MsgBox "Unable to apply user's default signature." & vbCrLf & _ 
                vbCrLf & "This is likely due to Excel's current Macro " & _
                          Security Settings.", vbOKOnly, "Error"
        Resume Continue1
    
    ReplyToError:
        MsgBox "Unable to apply alternate 'Reply To' address." & vbCrLf & _
               vbCrLf & "This is likely due to Excel's current Macro " & _
               Security Settings.", vbOKOnly, "Error"
        Resume Continue2
        
    End Sub


    Vish Mishra

    Thursday, November 24, 2016 6:07 AM
  • Vish,

    I tried that and received the same error.  Can you think of another way to insert the default signature?

    -Grasor

    Thursday, November 24, 2016 10:58 AM
  • I assume that you are running the code from Excel? That being the case, you should create a new module and add Ben Clothier's function to open/get Outlook as Outlook doesn't always behave as expected when it is opened with CreateObject. The function is discussed at the link in the code below.

    Option Explicit
    'Ben Clothier - http://www.rondebruin.nl/win/s1/outlook'/openclose.htm
    #Const LateBind = True
    
    Const olMinimized As Long = 1
    Const olMaximized As Long = 2
    Const olFolderCalendar As Long = 9
    Const olFolderContacts As Long = 10
    Const olFolderDrafts As Long = 16
    Const olFolderInbox As Long = 6
    Const olFolderOutbox = 4
    Const olFolderSentMail = 5
    Const olFolderTasks = 13
    
    #If LateBind Then
    
    Public Function OutlookApp( _
           Optional WindowState As Long = olMinimized, _
           Optional Folder As Long = olFolderInbox, _
           Optional ReleaseIt As Boolean = False _
           ) As Object
    Static o As Object
    #Else
    Public Function OutlookApp( _
           Optional WindowState As Outlook.OlWindowState = olMinimized, _
           Optional Folder As Long = olFolderInbox, _
           Optional ReleaseIt As Boolean _
           ) As Outlook.Application
    Static o As Outlook.Application
    #End If
        On Error GoTo ErrHandler
    
        Select Case True
            Case o Is Nothing, Len(o.Name) = 0
                Set o = GetObject(, "Outlook.Application")
                If o.Explorers.Count = 0 Then
    InitOutlook:
                    'Open inbox to prevent errors with security prompts'
                    o.Session.GetDefaultFolder(Folder).display
                    o.ActiveExplorer.WindowState = WindowState
                End If
            Case ReleaseIt
                Set o = Nothing
        End Select
        Set OutlookApp = o
    
    ExitProc:
        Exit Function
    ErrHandler:
        Select Case Err.Number
            Case -2147352567
                'User cancelled setup, silently exit'
                Set o = Nothing
            Case 429, 462
                Set o = GetOutlookApp()
                If o Is Nothing Then
                    Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
                Else
                    Resume InitOutlook
                End If
            Case Else
                MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
        End Select
        Resume ExitProc
        Resume
    End Function
    
    #If LateBind Then
    Private Function GetOutlookApp() As Object
    #Else
    Private Function GetOutlookApp() As Outlook.Application
    #End If
        On Error GoTo ErrHandler
        Set GetOutlookApp = CreateObject("Outlook.Application")
    ExitProc:
        Exit Function
    ErrHandler:
        Select Case Err.Number
            Case Else
                'Do not raise any errors'
                Set GetOutlookApp = Nothing
        End Select
        Resume ExitProc
        Resume
    End Function

    Having done so you need to modify your code to use the Word Inspector to edit the message body. Then you don't have to faff around with the signatures. The default signature for the account will be included as a matter of course. I have added the relevant code to yours and included a simple test macro so that you can check that it works.

    Ensure that you leave the .Display command - even if you resurrect the .Send command of the message will not be created correctly. I have left your error handling untouched so that you can establish if it is still required.

    Option Explicit
    Sub TestMacro()
    WriteMail "someone@somewhere.com", "", "", "This is the message body text", "This is the subject"
    End Sub

    Sub WriteMail(sToRecipients As String, _
                  sCCRecipients As String, _
                  sBCCRecipients As String, _
                  sBody As String, _
                  sSubject As String)
    'Graham Mayor - http://www.gmayor.com - Last updated - 24/11/2016
    'Sub opens a new mail message in outlook and builds
    'out the contents based on user input.


    'Late Binding (Best for Distribution/Compatibility)
    Dim oOutlook As Object
    Dim oMailItem As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object

        On Error Resume Next
        'Use Ben Clothier's function to get Outloook - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
        Set oOutlook = OutlookApp()
        Set oMailItem = oOutlook.CreateItem(0) 'You must use the numeric equivalent with late binding

        With oMailItem
            'Add Recipients
            .TO = sToRecipients
            .CC = sCCRecipients
            .BCC = sBCCRecipients
            .Recipients.ResolveAll    'May cause error depending on
            'security settings.  Formats all e-mail
            'addresses as valid "mailto:" items.

            'Set Subject
            .Subject = sSubject

            'Mail Body Format
            .BodyFormat = 2 'You must use the numeric equivalent with late binding

            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.Collapse 1
            .display
            oRng.Text = sBody


    Continue1:

            On Error GoTo ReplyToError:
            .ReplyRecipients.Add Range("Config_AlternateReplyTo")    'This can
            'cause an error
            'depending on
            'security settings.

    Continue2:

            'Send E-Mail Automatically (Disabled)
            '.Send
        End With

        'This procedure is done.  Destroy all objects to clear memory.

        Set oMailItem = Nothing
        Set oOutlook = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub    'If this is not here then the procedure will execute the error
        'handlers below even if there isn't an error!


    ReplyToError:
        MsgBox "Unable to apply alternate 'Reply To' address." & vbCrLf & _
               vbCrLf & "This is likely due to Excel's current Macro " & _
               "Security Settings.", vbOKOnly, "Error"
        Resume Continue2
    End Sub




    Graham Mayor - Word MVP
    www.gmayor.com


    • Edited by Graham MayorMVP Thursday, November 24, 2016 1:00 PM
    • Marked as answer by Grasor Friday, November 25, 2016 12:39 PM
    Thursday, November 24, 2016 12:57 PM
  • Graham,

    My program uses the TestOutlookIsOpen() test on Rondebruin's site.  This is preferred because I want to use Late Binding and users who have to login can have issues, in my experience, with Excel macro's jumping the gun while the user enters credentials after Outlook is open.  There's probably a way around that but this is reliable and suits my needs.  As a result I'm not yet using the OpenOutlook() function to instantiate the Outlook Object.  I did, however, change the Set oOutlook = CreateObject to GetObject as that was a mistake.

    I've integrated your code into mine but am again getting some strange behavior.  On this section of code:

    [code]

            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.Collapse 1
            .Display
            oRng.Text = sBody

    [/code]

    The "Set wdDoc = olInsp.WordEditor" line does not actually instantiate the wdDoc object.  It remains "Nothing."  Thus everything below it fails to work.  Interestingly I do not receive an error.

    The result is the Outlook Message is displayed with the User's Default Outlook signature, recipients, and subject entered.  However, the body of the message remains unchanged / empty.

    However, I tried the code on a personal system with more open Macro Security and it worked fine.  So I think I'm just not able to perform this task on certain systems.

    Thanks as always Graham.

    -G


    • Edited by Grasor Friday, November 25, 2016 12:39 PM
    Friday, November 25, 2016 10:24 AM
  • It appears it is not as reliable as you thought :)  

    Running Outlook code from external applications is a minefield. Ben Clothier's macro http://www.rondebruin.nl/win/s1/outlook/openclose.htm is the most reliable method I have found.

    If you need users to log on then add

    Dim olNS As Object
        Set olNS =  oOutlook.GetNamespace("MAPI")
        olNS.logon

    before

     Set oMailItem = oOutlook.CreateItem(0)



    Graham Mayor - Word MVP
    www.gmayor.com


    Friday, November 25, 2016 1:23 PM