Visual Basic - Crear Mail con firma

'crear aplicacion Outlook

Dim oApp As Outlook.Application

Set oApp = New Outlook.Application

' Crear un nuevo elemento de correo.

Dim oMsg As Outlook.MailItem

Set oMsg = oApp.CreateItem(Outlook.OlItemType.olMailItem)

oMsg.Subject = "Enviar datos"

oMsg.Body = "Texto de ejemplo" & vbCr & vbCr

oMsg.To = "destinatario@miejemplo.com"

'mostrar mail

oMsg.Display

'descargar variables

oApp = Nothing

oMsg = Nothing

'--------------------------------------------------------

Sub Mail_Outlook_With_Signature_Plain()

    Dim OutApp As Object

    Dim OutMail As Object

    Dim strbody As String

    Dim SigString As String

    Dim Signature As String

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi there" & vbNewLine & vbNewLine & _

              "This is line 1" & vbNewLine & _

              "This is line 2" & vbNewLine & _

              "This is line 3" & vbNewLine & _

              "This is line 4"

    SigString = "C:Documents and Settings" & Environ("username") & _

                "Application DataMicrosoftSignaturesMysig.txt"

    If Dir(SigString) <> "" Then

        Signature = GetBoiler(SigString)

    Else

        Signature = ""

    End If

    On Error Resume Next

    With OutMail

        .To = "ron@debruin.nl"

        .CC = ""

        .BCC = ""

        .Subject = "This is the Subject line"

        .Body = strbody & vbNewLine & vbNewLine & Signature

        'You can add files also like this

        '.Attachments.Add ("C:	est.txt")

        .Send   'or use .Display

    End With

    On Error GoTo 0

    Set OutMail = Nothing

    Set OutApp = Nothing

End Sub

Function GetBoiler(ByVal sFile As String) As String

'Dick Kusleika

    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

Sub OutlookMailExcelAdjunto()

Dim OutApp As Object

Dim OutMail As Object

'Ultima fila usada

ultFil = Range("A:A").Find("*", , , , , xlPrevious).Row

'Outlook

Set OutApp = CreateObject("Outlook.Application")

'Se crea la conexión con el gestor de correo

Set OutApp = CreateObject("Outlook.Application")

OutApp.Session.logon

'Se crea metodo de envio de correo

Set OutMail = OutApp.CreateItem(0)

ActiveWorkbook.Save

'Se definen el destinatario, la copia y la copia oculta, el asunto

'el cuerpo del correo y los archivos adjuntos si se requiere.Especificando

'los campos usados.

On Error Resume Next

With OutMail

.To = Range("B4").Value

.CC = Range("B5").Value

.BCC = Range("B6").Value

.Subject = Range("B7").Value

.Body = Range("B8") & Firma.Value

.Attachments.Add Range("B9").Value

.Send

End With

On Error GoTo 0

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

Dim CorreoAutomatico = New Outlook.Application

Dim Mail As Outlook.MailItem = CorreoAutomatico.CreateItem(Outlook.OlItemType.olMailItem)

'Asignamos las propiedades a nuestra Instancial del objeto 

'MailItem 

Mail.To = Email

Mail.Subject = "Confirmation Of Reservation " + ReservationID

Mail.Body = "Escriba aquí el cuerpo del mensaje"

'enviar un archivo adjunto… 

Dim RutaArchivoAdjunto As String = Ruta

Dim NombreArchivoAdjunto As String = ReservationID

Dim LonguitudArchivo As String = Mail.Body.Length

Dim oAttachs As Outlook.Attachments = Mail.Attachments

Dim oAttach As Outlook.Attachment

oAttach = oAttachs.Add(RutaArchivoAdjunto, , LonguitudArchivo + 1, NombreArchivoAdjunto)

'Enviamos nuestro Mail 

Mail.Display()

Close()

Sub eMail_Hoja_Activa()

'-------------------

' by Cacho Rodríguez

'-------------------

Dim attBook$

attBook = Environ("temp") & "\Libro2.xlsx"

' Guardo la hoja activa como un libro independiente

ActiveSheet.Copy

If Dir(attBook) <> "" Then Kill attBook

With ActiveWorkbook

  .SaveAs Filename:=attBook, FileFormat:=51

  .Close False

End With

' Creo el objeto Outlook

With CreateObject("Outlook.Application")

' Creo el nuevo mail

  With .CreateItem(0)

' Incorporo el archivo que se adjunta

.To = ""

.CC = ""

.Subject

.Body =

.Attachments.Add attBook

    .Display

  End With

End With

End Sub

.Body = strbody & vbNewLine & vbNewLine & Signature

.HTMLBody = "<html>" & _

	"<body>" & _

	"<img src='cid:'" & .Attachments.Item(1).Filename & _

	"</body>" & _

	"</html>"

With OutMail

'Firma = objMail.HTMLBody

Set dam = CreateObject("outlook.application").CreateItem(0)

dam.To = Range("B" & i)

dam.CC = Range("C" & i)

dam.Bcc = Range("D" & i)

dam.Subject = Range("E" & i)

dam.body = "Estimados..." & Chr(vbKeyReturn) & Chr(vbKeyReturn) &