Notifications
Clear all

Como adicionar asssinatura no email apartir do arquivo rtf?

8 Posts
3 Usuários
0 Reactions
1,756 Visualizações
(@jeffreitas)
Posts: 0
New Member
Topic starter
 

Eu estou usando esse código para enviar emails numa lista e está funcionando. Eu queria adicionar uma assinatura no final da mensagem (sem imagens, somente texto). O arquivo da assinatura está em formato *.rtf.

Sub MandaEmail()

Dim EnviarPara As String
Dim ComCopia As String
Dim Assunto As String
Dim Mensagem As String
For i = 1 To 112
EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
ComCopia = ThisWorkbook.Sheets(1).Cells(i, 2)
Assunto = ThisWorkbook.Sheets(1).Cells(i, 3)
Mensagem = ThisWorkbook.Sheets(1).Cells(i, 4)
If EnviarPara <> "" Then
Mensagem = ThisWorkbook.Sheets(1).Cells(i, 4)
Envia_Emails EnviarPara, ComCopia, Assunto, Mensagem
End If
Next i
End Sub

Sub Envia_Emails(EnviarPara As String, ComCopia As String, Assunto As String, Mensagem As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = EnviarPara
.CC = ComCopia
.BCC = ""
.Subject = Assunto
.Body = Mensagem
.Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

 
Postado : 24/03/2018 9:15 am
(@jeffreitas)
Posts: 0
New Member
Topic starter
 

O arquivo está nesta pasta:

C:UsersjeffeAppDataRoamingMicrosoftSignaturesjeffeson1.rtf

 
Postado : 24/03/2018 10:05 am
(@klarc28)
Posts: 0
New Member
 

Quando colocar código neste fórum, aperte o botão Code.

 
Postado : 24/03/2018 3:33 pm
(@jeffreitas)
Posts: 0
New Member
Topic starter
 

Ok.

 
Postado : 24/03/2018 3:44 pm
(@basole)
Posts: 487
Reputable Member
 

jeffeson nesse mesmo diretório que citou, acredito que contenha também o arquivo assinatura em formato texto => ....jeffeson1.txt

No exemplo, a busca da assinatura é por este arquivo.


Sub MandaEmail()
    
    Dim EnviarPara As String
    Dim ComCopia As String
    Dim Assunto As String
    Dim Mensagem As String
    Dim assPath As String
    
    assPath = "C:UsersjeffeAppDataRoamingMicrosoftSignaturesjeffeson1.txt"
    
    For i = 1 To 112
        EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
        ComCopia = ThisWorkbook.Sheets(1).Cells(i, 2)
        Assunto = ThisWorkbook.Sheets(1).Cells(i, 3)
        Mensagem = ThisWorkbook.Sheets(1).Cells(i, 4)
        If EnviarPara <> "" Then
            Mensagem = ThisWorkbook.Sheets(1).Cells(i, 4)
            Envia_Emails EnviarPara, ComCopia, Assunto, Mensagem, assPath
        End If
    Next i
End Sub

Sub Envia_Emails(EnviarPara As String, ComCopia As String, Assunto As String, Mensagem As String, assPath As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim assStr As String
    Dim fso As Object
    Dim opTxt As Object
    
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set opTxt = fso.GetFile(assPath).OpenAsTextStream(1, -2)
    assStr = opTxt.readall
    
    With OutlookMail
        .To = EnviarPara
        .CC = ComCopia
        .BCC = ""
        .Subject = Assunto
        .Body = Mensagem & vbCr & vbCr & assStr
        .Send
    End With
    
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    Set fso = Nothing
    Set opTxt = Nothing
    
End Sub

 
Postado : 24/03/2018 7:49 pm
(@jeffreitas)
Posts: 0
New Member
Topic starter
 

Ele puxa a assinatura do arquivo txt, mas é o texto sem formatação. Eu queria que puxasse do outro arquivo, que tem o texto formatado (rtf).

Aproveitando, tem como fazer com que do texto da mensagem colocado na planilha seja preservada a formatação também?

 
Postado : 25/03/2018 7:41 am
(@jeffreitas)
Posts: 0
New Member
Topic starter
 

Alguém pode me ajudar, ainda não consegui.

 
Postado : 30/06/2018 12:13 pm
(@jeffreitas)
Posts: 0
New Member
Topic starter
 

O código que o colega enviou funciona, mas a assinatura fica sem formatação. Na pasta das assinaturas tem um arquivo .rtf que tem a assinatura formatada. Como faço pra o email puxar essa assinatura formatada?

 
Postado : 30/06/2018 3:05 pm