Definir prioridade alta email outlook

2024 - VBA & Macros

Post Recente por engeel2014 8 anos atrás

2 Posts

2 Usuários

0 Reactions

1,116 Visualizações

RSS

CZa

(@cza)

Posts: 61

Trusted Member

Topic starter

Falai pessoa...

Tenho uma rotina a qual faz o envio de emails de arquivos PDF gerados conforme minha demanda, e gostaria de inserir nele a função de definir a prioridade como sendo alta para envio, vi a função .Importance = olImportanceHigh, onde é possível definir a prioridade como alta, porém não consegui adapta-la a rotina que ja tenho.

Alguém poderia me auxiliar?

Option Explicit
Sub Mail_Every_Worksheet_With_Address_In_A1_PDF()
'Working only in 2007 and up
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String
    'Temporary path to save the PDF files
    'You can also use another folder like
    'TempFilePath = "C:UsersRonMyFolder"
    TempFilePath = Environ$("temp") & ""
        Plan15.Range("EM76").Value = Now()
            TempFileName = TempFilePath & "ORDEM DE COMPRA Nº " & Plan15.Range("GY4").Value & " - " _
                         & Format(Now, "dd-mm-YYyy hH-mm-ss") & ".pdf"

            FileName = RDB_Create_PDF(Source:=Plan15, _
                                      FixedFilePathName:=TempFileName, _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)

            'If publishing is OK create the mail
            If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:=Plan15.Range("FW13").Value, _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Solicitação DuPont Pioneer | " & Plan15.Range("P10") & " - " & Format(Now, "dd/mm"), _
                                     Signature:=True, _
                                     Send:=False, _
                                     StrBody:="<BODY style=font-size:11pt;font-family:calibri><b>Caro fornecedor;</b><p>Segue em anexo ordem de compra nº " & Plan15.Range("GY4").Value & ", favor enviar cotação para a mesma e aguardar ordem de envio.</BODY>"
                '.Importance = olImportanceHigh
            Else
                MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                       "Microsoft Add-in is not installed" & vbNewLine & _
                       "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                       "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                       "You didn't want to overwrite the existing PDF if it exist"
            End If
End Sub


Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrCC As String, StrBCC As String, StrSubject As String, _
                              Signature As Boolean, Send As Boolean, StrBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
    

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        If Signature = True Then .Display
        .To = StrTo
        .CC = StrCC
        .BCC = StrBCC
        .Subject = StrSubject
        .HTMLBody = StrBody & .HTMLBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Postado : 24/08/2016 10:38 am