I have the following code which i copied from this post (credit to Chazjn):
Dim WithEvents myInspector As Outlook.Inspectors
Dim WithEvents myMailItem As Outlook.MailItem
Private Sub Application_Startup()
Set myInspector = Application.Inspectors
End Sub
Private Sub myInspector_NewInspector(ByVal Inspector As Outlook.Inspector)
If TypeOf Inspector.CurrentItem Is MailItem Then
Set myMailItem = Inspector.CurrentItem
End If
End Sub
Private Sub myMailItem_PropertyChange(ByVal Name As String)
On Error GoTo ErrorCatcher
Dim signatureName As String
Dim signatureFilePath As String
' Properties we are interested in: "SendUsingAccount" / "SentOnBehalfOfName"
' Both get fired when the 'From' field is changed/re-selected
' So we are only going to trigger on one event or we will call the code twice
If Name = "SentOnBehalfOfName" Then
' Delete the current signature
Call DeleteSignature(myMailItem)
' Insert the new signature at the current cursor point
' The cursor will be at the point where the old signature was deleted
signatureName = GetSignatureName(myMailItem.SentOnBehalfOfName)
signatureFilePath = GetSignatureFilePath(signatureName)
Call InsertSignature(myMailItem, signatureFilePath)
End If
Exit Sub
ErrorCatcher:
MsgBox Err.Description
End Sub
Private Function DeleteSignature(objMail As Outlook.MailItem)
Dim objDoc As Word.Document
Dim objBkm As Word.Bookmark
Set objDoc = objMail.GetInspector.WordEditor
If objDoc.Bookmarks.Exists("_MailAutoSig") Then
Set objBkm = objDoc.Bookmarks("_MailAutoSig")
objBkm.Select
objDoc.Windows(1).Selection.Delete
End If
End Function
Private Function GetSignatureName(sender As String)
Select Case sender
Case "Sales"
GetSignatureName = "Sales"
Case Else
GetSignatureName = "default"
End Select
End Function
Private Function GetSignatureFilePath(signatureName As String) As String
GetSignatureFilePath = Environ("AppData") & "\Microsoft\Signatures\" & signatureName & ".htm"
End Function
Private Function InsertSignature(objMail As MailItem, signatureFilePath As String)
Dim objDoc As Word.Document
Dim rngStart As Range
Dim rngEnd As Range
Set objDoc = objMail.GetInspector.WordEditor
Set rngStart = objDoc.Application.Selection.Range
rngStart.Collapse wdCollapseStart
Set rngEnd = rngStart.Duplicate
rngEnd.InsertParagraph
rngStart.InsertFile signatureFilePath, , , , False
rngEnd.Characters.Last.Delete
objDoc.Bookmarks.Add "_MailAutoSig", rngEnd
End Function
It essentially just changes the signature based on whatever email I select in the "from" list.
It works perfectly fine when i hit "New Email" but when i go to hit "reply" the code won't work unless I hit the "pop out" button. Can anyone help explain why this is and what i can do to make the code work when replying without having to pop out the message?
