VBA: ENVIAR EMAIL COM ANEXO EM PDF

 Tópico anterior Próximo tópico Novo tópico

VBA: ENVIAR EMAIL COM ANEXO EM PDF

VB / VBA

 Compartilhe  Compartilhe  Compartilhe
#490431 - 14/09/2019 13:14:44

IVANPI
GUAPIARA
Cadast. em:Janeiro/2017


Somente para que eu possa pesquisar mais :)

É possível criar uma rotina no VBA do Excel, para que eu possa enviar emails, com anexos em PDF?

Exemplo, eu tenho uma lista com 10 alunos, no qual o Excel importa dados e constrói boletins para esses alunos. Gostaria que, o Excel exportasse o boletim em PDF (isso já consigo fazer), pegasse esse boletim em PDF no caminho do arquivo, anexasse ao email, fazendo um loop por esses 10 alunos.

Atualmente eu uso uma rotina para envio de emails pelo Outlook.

É possível eu fazer isso no VBA?

Por favor poderiam me dar algumas dicas para que eu pesquise? Obrigado :)



Resposta escolhida #490486 - 19/09/2019 19:50:51

EDSON PEREIRA
SAO PAULO
Cadast. em:Janeiro/2004


 Anexos estao visíveis somente para usuários registrados

Boa Noite!
ver ser servi!

Sub cmdEnviarEMmail()
If ValidarCampo(Sheets(1).Range("txtNome")) = False Then
    Sheets("DADOS").Select
    Range("txtNome").Select
    Exit Sub
End If
'***
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, MensagenDia As String
Dim OutApp As Object, OutMail As Object 'Objetos Aplicação do Outlook
On Error GoTo MsgErro

'***Definir o nome do arquivo PDF
    PdfFile = ActiveWorkbook.FullName
    i = InStrRev(PdfFile, ".")
    If i > 1 Then PdfFile = Left(PdfFile, i - 1)
    PdfFile = UCase(PdfFile & ".pdf")

'***Nome da planilha desejado
    Sheets(Array("REQUERIMENTO", "PROTOCOLO", "PROCURAÇÃO", "DECLARAÇÃO", "ELEITORAL")).Select
    
'***Exportar folha de atividades como PDF
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With

'***Use já o Outlook aberto, se possível
    On Error Resume Next
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    If Err Then
        Set OutApp = CreateObject("Outlook.Application")
        IsCreated = True
    End If
    On Error GoTo 0

'***Prepare e-mail com anexo de PDF
    With OutMail
    '***Mensagem de boas vindas
        If Time$ > "19:00:00" Then
            MensagenDia = "Boa noite,..."
        ElseIf Time$ > "12:00:00" Then
            MensagenDia = "Boa tarde,..."
        ElseIf Time$ > "00:00:00" Then
            MensagenDia = "Bom dia,..."
        End If
    '***Prepare e-mail
        .Subject = "REQUERIMENTO PARA REGISTRO NO EXÉRCITO"
        .To = LCase((Plan1.Range("txtEMail").Text))
        .body = "Oi, " & MensagenDia & vbLf & "O relatório está anexado em formato PDF." & vbLf & "Saudações," & vbLf & Application.UserName & vbLf & vbLf
        .Attachments.Add PdfFile
        
    '***Tente enviar
        On Error Resume Next
        .display
        Sheets("DADOS").Select
        Application.Visible = True
        If Err Then
            MsgBox "O e-mail não foi enviado", vbExclamation
        Else
            MsgBox "E-mail enviado com sucesso", vbInformation
        End If
        On Error GoTo 0
    End With

'***Excluir arquivo PDF
    Kill PdfFile

'***Saia do Outlook se foi criado por este código
    If IsCreated Then OutApp.Quit

'***Liberte a memória da variável de objeto
    Set OutApp = Nothing
    Set OutApp = Nothing
Exit Sub
MsgErro:
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Error numero. " & Err & vbCrLf & "Descrição. " & Err.Description, vbInformation, "ATENÇÃO! AVISO IMPORTANTE!"
'>>>
End Sub





#490526 - 26/09/2019 19:20:47

IVANPI
GUAPIARA
Cadast. em:Janeiro/2017


Citação:
:
Boa Noite!
ver ser servi!

Sub cmdEnviarEMmail()
If ValidarCampo(Sheets(1).Range("txtNome")) = False Then
    Sheets("DADOS").Select
    Range("txtNome").Select
    Exit Sub
End If
'***
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, MensagenDia As String
Dim OutApp As Object, OutMail As Object 'Objetos Aplicação do Outlook
On Error GoTo MsgErro

'***Definir o nome do arquivo PDF
    PdfFile = ActiveWorkbook.FullName
    i = InStrRev(PdfFile, ".")
    If i > 1 Then PdfFile = Left(PdfFile, i - 1)
    PdfFile = UCase(PdfFile & ".pdf")

'***Nome da planilha desejado
    Sheets(Array("REQUERIMENTO", "PROTOCOLO", "PROCURAÇÃO", "DECLARAÇÃO", "ELEITORAL")).Select
    
'***Exportar folha de atividades como PDF
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With

'***Use já o Outlook aberto, se possível
    On Error Resume Next
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    If Err Then
        Set OutApp = CreateObject("Outlook.Application")
        IsCreated = True
    End If
    On Error GoTo 0

'***Prepare e-mail com anexo de PDF
    With OutMail
    '***Mensagem de boas vindas
        If Time$ > "19:00:00" Then
            MensagenDia = "Boa noite,..."
        ElseIf Time$ > "12:00:00" Then
            MensagenDia = "Boa tarde,..."
        ElseIf Time$ > "00:00:00" Then
            MensagenDia = "Bom dia,..."
        End If
    '***Prepare e-mail
        .Subject = "REQUERIMENTO PARA REGISTRO NO EXÉRCITO"
        .To = LCase((Plan1.Range("txtEMail").Text))
        .body = "Oi, " & MensagenDia & vbLf & "O relatório está anexado em formato PDF." & vbLf & "Saudações," & vbLf & Application.UserName & vbLf & vbLf
        .Attachments.Add PdfFile
        
    '***Tente enviar
        On Error Resume Next
        .display
        Sheets("DADOS").Select
        Application.Visible = True
        If Err Then
            MsgBox "O e-mail não foi enviado", vbExclamation
        Else
            MsgBox "E-mail enviado com sucesso", vbInformation
        End If
        On Error GoTo 0
    End With

'***Excluir arquivo PDF
    Kill PdfFile

'***Saia do Outlook se foi criado por este código
    If IsCreated Then OutApp.Quit

'***Liberte a memória da variável de objeto
    Set OutApp = Nothing
    Set OutApp = Nothing
Exit Sub
MsgErro:
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Error numero. " & Err & vbCrLf & "Descrição. " & Err.Description, vbInformation, "ATENÇÃO! AVISO IMPORTANTE!"
'>>>
End Sub




Olá, vou testar aqui... desde já muito agradecido pela disposição!

At.te,

Ivan JPi



 Tópico anterior Próximo tópico Novo tópico


Tópico encerrado, respostas não sao permitidas
Encerrado por IVANPI em 26/09/2019 19:21:01