locked
VBA: Mail with Signature via Excel RRS feed

  • Question

  • Hi,

    actually the follwing code does not include the signature from outlook. 

    It is possible to insert the signature via '.getinspector.display' but I don't know how to apply in my code.

    Can anyone help please

    TY, KR, Robi

    Sub AnlagenMailen999()
    Dim oOL As Object
    Dim oOLMsg As Object
    Dim oOLRecip As Object
    Dim oOLAttach As Object
    Dim iRow As Integer, iCounter As Integer
    Dim sFile, sRec As String, sSub As String
    Dim sBody As String
    Dim bln, S
    Application.ScreenUpdating = False
    iRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set oOL = CreateObject("Outlook.Application")
    For iCounter = 2 To iRow
    sRec = Cells(iCounter, 1) 'An
    sFile = WorksheetFunction.Transpose(WorksheetFunction.Transpose _
      (Cells(iCounter, 4).Resize(, 3)))
    sSub = Cells(iCounter, 2)  'Betreff
    sBody = Cells(iCounter, 10) & Cells(iCounter, 9) & "," & vbLf & vbLf & Worksheets("Tabelle2").Range("A1") 'Text
    Set oOLMsg = oOL.CreateItem(0)
    With oOLMsg
    Set oOLRecip = .Recipients.Add(sRec)
    .Subject = sSub
    .Body = sBody & vbLf & vbLf
    For S = LBound(sFile) To UBound(sFile)
      If Len(sFile(S)) Then .Attachments.Add sFile(S)
    Next S
    .Display
    End With
    oOLRecip.Resolve
    Next iCounter
    Set oOL = Nothing
    End Sub


    Saturday, April 23, 2016 9:25 PM

Answers

  •  

    Hi, RobiElf

    As soon as you create a signature in Outlook it saves the signature in 3 different types of files: .HTM, TXT and RTF as shown below:

    These files get stored at the following location in your system:

    Windows XP :
    C:\Documents and Settings\Vish\Application Data\Microsoft\Signatures

    Windows 7 and 8 :
    C:\Users\Vish\AppData\Roaming\Microsoft\Signatures


    You could refer to below code to create mail item and signature with Simple Text

    Function GetSignature(fPath As String) As String  
        Dim fso As Object  
        Dim TSet As Object  
        Set fso = CreateObject("Scripting.FileSystemObject")  
        Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)  
        GetSignature= TSet.readall  
        TSet.Close  
    End Function  
    
    Sub With_Text_Signature()  
      
        'Do not forget to change the email ID  
        'before running this code  
      
        Dim OlApp As Object  
        Dim NewMail As Object  
        Dim EmailBody As String  
        Dim StrSignature As String  
        Dim sPath As String  
      
        Set OlApp = CreateObject("Outlook.Application")  
        Set NewMail = OlApp.CreateItem(0)  
      
        EmailBody = "Type the Body of your email"  
      
        sPath = Environ("appdata") & "\Microsoft\Signatures\vish.txt"  
      
        ' If the path and file name given by you is not  
        ' correct then code you insert a blank Signature  
          
        If Dir(sPath) <> "" Then  
            StrSignature = GetSignature(sPath)  
        Else  
            StrSignature = ""  
        End If  
      
        On Error Resume Next  
        With NewMail  
            .To = "info@xxxxx.com"  
            .CC = "info@xxxxx.com"  
            .BCC = "info@xxxxx.com"  
            .Subject = "Type your Subject here"  
            ' Here at the end of the Email Body  
            ' Text Signature is inserted.  
            .Body = EmailBody & vbNewLine & vbNewLine & StrSignature  
            .send  
        End With  
        On Error GoTo 0  
        Set NeMail = Nothing  
        Set OlApp = Nothing  
    End Sub  


    Monday, April 25, 2016 1:42 AM

All replies

  • This is one example but from what get, he has set a default signature to be included in the email. Maybe that's all you need to do?

    http://www.rondebruin.nl/win/s1/outlook/signature.htm


    Best regards, George

    Sunday, April 24, 2016 12:02 PM
  • Another way is you can Append your signature to the end of your sbody above.

    chanmm

     

    chanmm

    Sunday, April 24, 2016 12:07 PM
  • can you adapt the code and post it here?

    I've tried several versions, but I don't find the correct solution... :(

    Sunday, April 24, 2016 3:47 PM
  •  

    Hi, RobiElf

    As soon as you create a signature in Outlook it saves the signature in 3 different types of files: .HTM, TXT and RTF as shown below:

    These files get stored at the following location in your system:

    Windows XP :
    C:\Documents and Settings\Vish\Application Data\Microsoft\Signatures

    Windows 7 and 8 :
    C:\Users\Vish\AppData\Roaming\Microsoft\Signatures


    You could refer to below code to create mail item and signature with Simple Text

    Function GetSignature(fPath As String) As String  
        Dim fso As Object  
        Dim TSet As Object  
        Set fso = CreateObject("Scripting.FileSystemObject")  
        Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)  
        GetSignature= TSet.readall  
        TSet.Close  
    End Function  
    
    Sub With_Text_Signature()  
      
        'Do not forget to change the email ID  
        'before running this code  
      
        Dim OlApp As Object  
        Dim NewMail As Object  
        Dim EmailBody As String  
        Dim StrSignature As String  
        Dim sPath As String  
      
        Set OlApp = CreateObject("Outlook.Application")  
        Set NewMail = OlApp.CreateItem(0)  
      
        EmailBody = "Type the Body of your email"  
      
        sPath = Environ("appdata") & "\Microsoft\Signatures\vish.txt"  
      
        ' If the path and file name given by you is not  
        ' correct then code you insert a blank Signature  
          
        If Dir(sPath) <> "" Then  
            StrSignature = GetSignature(sPath)  
        Else  
            StrSignature = ""  
        End If  
      
        On Error Resume Next  
        With NewMail  
            .To = "info@xxxxx.com"  
            .CC = "info@xxxxx.com"  
            .BCC = "info@xxxxx.com"  
            .Subject = "Type your Subject here"  
            ' Here at the end of the Email Body  
            ' Text Signature is inserted.  
            .Body = EmailBody & vbNewLine & vbNewLine & StrSignature  
            .send  
        End With  
        On Error GoTo 0  
        Set NeMail = Nothing  
        Set OlApp = Nothing  
    End Sub  


    Monday, April 25, 2016 1:42 AM