Ir para conteúdo
Fórum Script Brasil

Pedporto

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre Pedporto

Pedporto's Achievements

0

Reputação

  1. 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
×
×
  • Criar Novo...