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