Tenho uma macro para envio de e-mails, e preciso inserir a assinatura padrão da conta no envio.
A macro envia um e-mail com anexo, texto e imagem no corpo. O envio é realizado por outra conta (corporativa), por isso é enviado pelo e-mail secundário direto do servidor.
Porém, a macro não insere a assinatura da conta. É possível realizar a inserção sem precisar mudar toda a estrutura da macro?
Segue o código:
Código: Selecionar todos
Option Explicit
Dim lSalvar As String
Sub ArquivoAnexo()
Dim OutApp As Object
Dim OutMail As Object
Dim oEmail As Object
Dim strBody As String
Dim linha As String
Dim assunto As String
Dim destino As String
Dim anexo As String
Dim produto As String
Dim unidade As String
Dim retval As String
Dim nome_anexo As String
Dim validacao As String
Dim assinatura As String
linha = 3
produto = "x"
Do While produto <> ""
Set oEmail = CreateObject("CDO.Message")
produto = Sheets("Envio_Emails").Range("M" & linha)
unidade = Sheets("Envio_Emails").Range("N" & linha)
destino = Sheets("Envio_Emails").Range("O" & linha)
assunto = Sheets("Envio_Emails").Range("P" & linha)
anexo = Sheets("Envio_Emails").Range("Q" & linha)
nome_anexo = Sheets("Envio_Emails").Range("R" & linha)
validacao = Sheets("Envio_Emails").Range("L" & linha)
Sheets("Envio_Emails").Range("S1") = produto
retval = Dir(anexo)
If retval = nome_anexo Then
Else
GoTo proximo_anexo
End If
If anexo = "" Then
GoTo proximo_anexo
End If
Sheets("Envio_Emails").Select
ActiveSheet.Calculate
Select Case produto
Case Is = "X"
Sheets("RESULTADO_X").Select
Range("K3") = unidade
ActiveSheet.Calculate
Case Is = "Y"
If validacao = "Enviar" Then
Sheets("RESULTADO_Y").Select
Range("K3") = unidade
ActiveSheet.Calculate
Else: GoTo proximo_anexo
End If
End Select
On Error Resume Next
Call lCriarImagem
'strBody = "<body> </h2>Olá!<br/> <br/></h2>Segue a prévia do IRC de Junho.<h2> </h2> </h2><br/> <img src=""" & lSalvar & """ style=""""></body>"
strBody = Sheets("Envio_Emails").Range("B9") & "<img src=""" & lSalvar & """ style=""""></body>"
'UTILIZAR O SITE https://wordtohtml.net/ PARA GERAR O HTML
With oEmail
.Display
oEmail.From = "EMAIL@ENVIO"
oEmail.To = "EMAIL@RECEBIMENTO"
oEmail.Subject = assunto
oEmail.AddAttachment anexo
oEmail.HTMLBody = strBody & .HTMLBody
oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "meuserver.server"
oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/authenticate") = 1
''''''
''''''
'''''
oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email_login"
oEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "email_senha"
'''''
''''''
''''''
oEmail.Configuration.Fields.Update
oEmail.Send
End With
'MsgBox "Arquivo enviado com sucesso!", vbInformation
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
proximo_anexo:
linha = linha + 1
Loop
End Sub