VBA Outlook - Enviando mensagem sem interrupções - Send e-Mail without Security Warning.



Não tenho a menor idéia sobre a quantidade de tópicos escritos sobre isso aqui. Mas recebo algumas vezes por semana, solicitações de pessoas perguntando como desabilitar a mensagem de confirmação do MS Outlook ao enviar e-mails a partir do MS Excel, MS Word ou MS Powerpoint (É isso mesmo, dá para enviar e-mail através do Powerpoint). Vamos lá ,com os devidos e respeitosos créditos:

' Code: Send E-mail without Security Warnings
' OUTLOOK 2003 VBA CODE FOR 'ThisOutlookSession' MODULE
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.4 - 26/03/2008
' Please read the full tutorial here:
' http://www.everythingaccess.com/tutorials.asp?ID=Outlook-Send-E-mail-without-Security-Warning
' Please leave the copyright notices in place - Thank you.

Coloque o código abaixo num módulo do Outlook:

Private Sub Application_Startup()
   'IGNORE - This forces the VBA project to open and be accessible using automation
   '         at any point after startup
End Sub

Tome todos os cuidados ao copiar e colar para não fazê-los erroneamente.

' FnSendMailSafe
' --------------
' Simply sends an e-mail using Outlook/Simple MAPI.
' Calling this function by Automation will prevent the warnings
' 'A program is trying to send a mesage on your behalf...'
' Also features optional HTML message body and attachments by file path.
'
' The To/CC/BCC/Attachments function parameters can contain multiple items by seperating
' them by a semicolon. (e.g. for the strTo parameter, 'test@test.com; test2@test.com' is
' acceptable for sending to multiple recipients.
'
Public Function FnSendMailSafe(strTo As String, _
                        strCC As String, _
               strBCC As String, _
                        strSubject As String, _
               strMessageBody As String, _
                        Optional strAttachments) As Boolean

' (c) 2005 Wayne Phillips - Written 07/05/2005
' Last updated 26/03/2008 - Bugfix for empty recipient strings
' http://www.everythingaccess.com
'
' You are free to use this code within your application(s)
' as long as the copyright notice and this message remains intact.

On Error GoTo ErrorHandler:
    Dim MAPISession As Outlook.NameSpace
Dim MAPIFolder As Outlook.MAPIFolder
    Dim MAPIMailItem As Outlook.MailItem
Dim oRecipient As Outlook.Recipient
    Dim TempArray() As String
Dim varArrayItem As Variant
    Dim strEmailAddress As String
Dim strAttachmentPath As String
    Dim blnSuccessful As Boolean

    'Get the MAPI NameSpace object

    Set MAPISession = Application.Session

    If Not MAPISession Is Nothing Then

      'Logon to the MAPI session
      MAPISession.Logon , , True, False

      'Create a pointer to the Outbox folder
      Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)

      If Not MAPIFolder Is Nothing Then
        'Create a new mail item in the "Outbox" folder
        Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)

        If Not MAPIMailItem Is Nothing Then    
          With MAPIMailItem
            'Create the recipients TO
                TempArray = Split(strTo, ";")

                For Each varArrayItem In TempArray

                    strEmailAddress = Trim(varArrayItem)

                    If Len(strEmailAddress) > 0 Then

                        Set oRecipient = .Recipients.Add(strEmailAddress)

                        oRecipient.Type = olTo

                        Set oRecipient = Nothing

                    End If

                Next varArrayItem        

            'Create the recipients CC

                TempArray = Split(strCC, ";")

                For Each varArrayItem In TempArray

                    strEmailAddress = Trim(varArrayItem)

                    If Len(strEmailAddress) > 0 Then

                        Set oRecipient = .Recipients.Add(strEmailAddress)

                        oRecipient.Type = olCC

                        Set oRecipient = Nothing

                    End If


                Next varArrayItem        

            'Create the recipients CC

                TempArray = Split(strCC, ";")

                For Each varArrayItem In TempArray

                    strEmailAddress = Trim(varArrayItem)

                    If Len(strEmailAddress) > 0 Then

                        Set oRecipient = .Recipients.Add(strEmailAddress)

                        oRecipient.Type = olCC

                        Set oRecipient = Nothing

                    End If            

                Next varArrayItem        

            'Create the recipients BCC

                TempArray = Split(strBCC, ";")

                For Each varArrayItem In TempArray

                    strEmailAddress = Trim(varArrayItem)

                    If Len(strEmailAddress) > 0 Then

                        Set oRecipient = .Recipients.Add(strEmailAddress)

                        oRecipient.Type = olBCC

                        Set oRecipient = Nothing

                    End If

                Next varArrayItem

Tags: Bernardes, VBA, Office, Outlook, send, mail, send, e-Mail, without security, warning, FnSendMailSafe


André Luiz Bernardes
A&A® - Work smart, not hard.

Nenhum comentário:

Postar um comentário

diHITT - Notícias