Translate

2013年6月9日 星期日

[VBA]Automation of Sending Email in Outlook without Security Warning

20130627: I found out this method is valid only after the visual basic editor of the outlook application has been opened once in order to refresh the macro reference of the outlook.

it is very annoying a security dialog will be prompted for comfirmation when send email from any VBA macro out of Outlook.

After my investigation, it is impossible to turn off this annoying dialog, but it can be bypassed.

In my investigation, the dialog will be prompted out when the "olMailItem.send" method is called directly in any application out of outlook like below.

Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

Dim objMail As Outlook.MailItem
Set objMail = olApp.CreateItem(olMailItem)

With objMail
    .Subject = Subject_N
    .To = To_N
    .cc = CC_N
   
    .Attachments.Add (Attach_N)
   
    .Body = Body_N
   
    .Send

End With 'objMail

Therefore, I tried to pass the olMailItem to the outlook, let the outlook do the sending like below.

Application:

Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

Dim objMail As Outlook.MailItem
Set objMail = olApp.CreateItem(olMailItem)

With objMail
    .Subject = Subject_N
    .To = To_N
    .cc = CC_N
   
    .Attachments.Add (Attach_N)
   
    .Body = Body_N

End With 'objMail

Call olApp.SendNewMail(objMail)

Outlook(ThisOutlookSession):

Public Sub SendNewMail(objMail as olMailItem)
        objMail.Send
End Sub


However, it fails too. I found out once the olMailItem is created not in the outlook, the dialog will be still prompted. Even if I created another olMailItem, and copy its properties one by one, the trouble still exists.

So, only one way is left, pass the property one by one, let the outlook created the mail item. and send the mail itself like below.

Application:
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

Call olApp.SendNewMail(Subject_N, To_N, CC_N, Body_N, Attach_N)

Outlook(ThisOutlookSession):

 Public Sub SendNewMail(Subject_N As String, To_N As String, Optional CC_N As String = "", Optional Body_N As String = "", Optional Attach_N As String = "")
    Dim objMail As MailItem
    Set objMail = CreateItem(olMailItem)

    With objMail
        .Subject = Subject_N
        .To = To_N
        
        If CC_N <> "" Then
            .CC = CC_N
        End If
        
        If Body_N <> "" Then
            .Body = Body_N
        End If
        
        If Attach_N <> "" Then
            .Attachments.Add Attach_N
        End If
        
        .Send
        
    End With
    
End Sub


Finally, it works.


沒有留言:

張貼留言