[Ajuda] Macro Envio de e-mail pelo Excel

[Pedporto]

Amigos,

Preciso de uma pequena grande ajuda de vocês!

Venho desde o início da semana tentando montar uma macro para enviar alguns e-mails, sem perder o caráter "pessoal"(nome e empresa) e o texto desejado e preciso de qualquer forma pôr a assinatura.

Porém, depois de alguns dias de pesquisa não consegui uma solução para o seguinte problema..

Sub EnviaEmail()

Dim appOutlook As Object

Dim olMail As Object

Dim Nome As String

Dim diretorio As String

Dim SigString As String

Dim Signature As String

'Set do Looping

n = Range("D24").Value

For i = 1 To n

'Verifica se Outlook está aberto. Caso não esteja, criar nova instância

On Error Resume Next

Set appOutlook = GetObject(, "Outlook.Application")

If appOutlook Is Nothing Then

Set appOutlook = CreateObject("Outlook.Application")

End If

SigString = Environ("appdata") & _

"\Microsoft\Assinaturas\PedroPorto.htm"

If Dir(SigString) <> "" Then

Signature = GetBoiler(SigString)

Else

Signature = ""

End If

On Error GoTo 0

Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail

With olMail

.To = ActiveSheet.Range("C" & 2 + i)

.Subject = ActiveSheet.Range("G6")

' .Attachments.Add = "C:\Users\ppmarques\Desktop\Transnordestina"

.Body = "Prezado(a) " & ActiveSheet.Range("B" & 2 + i).Value & ActiveSheet.Range("F11") & ActiveSheet.Range("D" & 2 + i) & ActiveSheet.Range("G10") & Signature

'.Display ou .Send

.Display

End With

Next i

End Sub

Function GetBoiler(ByVal sFile As String) As String

Dim fso As Object

Dim ts As Object

Set fso = CreateObject("Scripting.FileSystemObject")

Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)

GetBoiler = ts.readall

ts.Close

End Function

A assinatura está em HTML e para manter a formatação do texto não posso por o .Body para .HTMLBody alguém tem alguma sugestão para ler a assinatura em html usando .Body ou manter a formatação do texto usando .HTMLBody ?

Desde já agradeço!!

Pedro