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 :)

possvel 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 constri 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.

possvel 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 Aplicao 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[], []PROCURAO[], []DECLARAO[], []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 possvel
    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 EXRCITO[]
        .To = LCase((Plan1.Range([]txtEMail[]).Text))
        .body = []Oi, [] & MensagenDia & vbLf & []O relatrio est anexado em formato PDF.[] & vbLf & []Saudaes,[] & 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 no 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 cdigo
    If IsCreated Then OutApp.Quit

[]***Liberte a memria da varivel de objeto
    Set OutApp = Nothing
    Set OutApp = Nothing
Exit Sub
MsgErro:
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox []Error numero. [] & Err & vbCrLf & []Descrio. [] & Err.Description, vbInformation, []ATENO! 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 Aplicao 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[], []PROCURAO[], []DECLARAO[], []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 possvel
    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 EXRCITO[]
        .To = LCase((Plan1.Range([]txtEMail[]).Text))
        .body = []Oi, [] & MensagenDia & vbLf & []O relatrio est anexado em formato PDF.[] & vbLf & []Saudaes,[] & 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 no 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 cdigo
    If IsCreated Then OutApp.Quit

[]***Liberte a memria da varivel de objeto
    Set OutApp = Nothing
    Set OutApp = Nothing
Exit Sub
MsgErro:
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox []Error numero. [] & Err & vbCrLf & []Descrio. [] & Err.Description, vbInformation, []ATENO! AVISO IMPORTANTE![]
[]>>>
End Sub




Ol, vou testar aqui... desde j muito agradecido pela disposio!

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