Consegui o codigo abaixo, porem agora não consigo inserir mensagem no corpo do e-mail
OBS: SE EU EDITAR O HTMLBODY TIRANDO O NOME "E-MAIL" A ASSINATURA NÃO É INCLUIDA NO EMAIL.... ALGUEM AJUDA?
Dim assinatura As Variant
Public Function pega_assinatura(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)
pega_assinatura = ts.readall
ts.Close
End Function
Sub Envio_Email()
On Error Resume Next
Dim myOlApp As Outlook.Application
Dim myItem As MailItem
Dim myAttachments As Attachments
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
Dim empresa As String
Dim dd, hh As Variant
Dim Data_Inicio As Date
Dim Data_fim As Date
Dim Para As String
Dim Copia As String
Dim arquivo As String
empresa = Plan1.Range("A2")
Data_Inicio = Plan1.Range("B2")
Data_fim = Plan1.Range("C2")
Para = Plan1.Range("E2")
Copia = Plan1.Range("F2")
arquivo = Plan1.Range("G2")
'Esta função está sendo considerada para o Windows NT, caso for o Windows XP o caminho para o arquivo de assinatura é C:Documents and Settings" & Environ("username") "Dados de AplicativosMicrosoftSignaturesSem título.htm")
assinatura = pega_assinatura("C:Documents and Settings" & Environ("jose.perez") & "Application DataMicrosoftSignaturesSem título.htm")
With myItem
.To = Para
.Cc = Copia
.Subject = "Gestão de senhas de internação - " & empresa & " de " & Data_Inicio & " à " & Data_fim
myAttachments.Add arquivo
'Além de colocar todo o conteúdo em formato HTML estas linhas pegam a assinatura na minha máquina.
.HTMLBody = "<html><body>" & Sheets("E-MAIL").Range("H2").Value & "<P>" & Sheets("E-MAIL").Range("i2").Value & assinatura & "</body></html>"
'myItem.SentOnBehalfOfName = Sheets("E-MAIL").Range("j2").Value
.Display
SendKeys ("%r"), True
End With
End Sub
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 09/07/2015 8:02 am