Outlook Macro

[wtnelso]

Hello,

I have written the following macro to add a signature at the end of an email. It works great for when sending a new message, but when replying to an email it doesn't work because it places the signature all the way at the bottom of the email, not just at the bottom of the most recent reply. Is there a way to differentiate between the most recent email and the overall email chain?

 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Call AddSignature(Item)
End Sub

Public Sub AddSignature(ByVal msgItem As Object)
    
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Dim prompt As String
    Dim strMsg As String
    Dim S As String
    Dim count As Integer: count = 0
    
    S = ReadSignature("Internal.htm")
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    Set recips = msgItem.Recipients
    For Each recip In recips
    Set pa = recip.PropertyAccessor
    If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@email.com") = 0 Then
        count = count + 1
    End If
    Next
    
    If (count > 0) Then
    
    Else
        msgItem.HTMLBody = msgItem.HTMLBody & S
    End If
    
End Sub

Private Function ReadSignature(sigName As String) As String
       Dim oFSO, oTextStream, oSig As Object
       Dim appDataDir, sig, sigPath, fileName As String
       appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
       sigPath = appDataDir & "\" & sigName

       Set oFSO = CreateObject("Scripting.FileSystemObject")
       Set oTextStream = oFSO.OpenTextFile(sigPath)
       sig = oTextStream.ReadAll
       fileName = Replace(sigName, ".htm", "") & "_files/"
       sig = Replace(sig, fileName, appDataDir & "\" & fileName)
       ReadSignature = sig
End Function