Replace Text in Email Subject

[Tomas]

Operating system::    Windows 10
Outlook version:     Outlook 365
Email type or host:    Exchange Online

---

Hello, Diane,

following code works great for replacement of prefixes AW:/WG: to Re:/Fwd: in any subject lines of my outgoing emails. Unfortunatelly, in case of new messages/messages without above mentioned prefixes, subject line will be completely removed and emails are sending with blank subject line.

Could you please check this code and get him to work properly? I tried to comment the line Item.Subject = Trim(strSubject). With this change subject line of new messages remains but AW:/WG: will not be replaced by Re:/Fwd:.

Your help will be highly appreciated.

Thank you in advance.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
   'https://windowsreport.com/outlook-subject-prefix-fw-re/
   Dim strSubject As String
   If InStr(Item.Subject, "AW") > 0 Then
      'If you don't want the prompt,
      'You can remove the MsgBox line and its correspoding "Else … End If" lines.
      If MsgBox("Do you want to remove the prefix 'AW'?", vbYesNo) = vbYes Then
         strSubject = Replace(Item.Subject, "AW:", "Re:", vbTextCompare)
      Else
         strSubject = Item.Subject
      End If
   End If

   If InStr(Item.Subject, "WG") > 0 Then
      If MsgBox("Do you want to remove the prefix 'WG'?", vbYesNo) = vbYes Then
         strSubject = Replace(Item.Subject, "WG:", "Fwd:", vbTextCompare)
      Else
         strSubject = Item.Subject
      End If
   End If

   Item.Subject = Trim(strSubject)
   Item.Save
End Sub

 

[Jay Freedman]

Because of the two If statements, when neither "AW" nor "WG" occurs in the Item.Subject, then none of the four statements that assign a value to strSubject can be executed. Then execution goes to the statement Item.Subject = Trim(strSubject), but strSubject has the default value "" so Item.Subject is set to "" (that is, the empty string).

The simplest change that fixes this is to add the following statement immediately after the Dim statement:

strSubject = Item.Subject

 

[Diane Poremsky]

It should work - it checks the first IF and set the subject - then does the second. Oh wait, it has nested IF statements and nothing indicating what to do if neither prefix is found.

If InStr(Item.Subject, "AW") > 0 Then
If MsgBox("Do you want to remove the prefix 'AW'?", vbYesNo) = vbYes Then
strSubject = Replace(Item.Subject, "AW:", "Re:", vbTextCompare)
Else
strSubject = Item.Subject
End If
End If

moving the strSubject line will work

If InStr(Item.Subject, "AW") > 0 Then
If MsgBox("Do you want to remove the prefix 'AW'?", vbYesNo) = vbYes Then
strSubject = Replace(Item.Subject, "AW:", "Re:", vbTextCompare)
End If
Else
strSubject = Item.Subject
End If

 

[Diane Poremsky]

BTW - this is one better way of doing it. And if you need to remove other prefixes (like External, add the prefix and the replacement in the arrays.

If you need to check for multiple prefixes, remove the Exit For line so it checks all values in the array.

Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
   Dim strSubject As String
   Dim olPrefix As Variant
   Dim olReplace As Variant
   Dim i As Long
  
   olPrefix = Array("AW:", "WG:")
   olReplace = Array("Re:", "Fwd:")
  
   strSubject = item.Subject
  
    For i = 0 To UBound(olPrefix)
        If InStr(1, strSubject, olPrefix(i)) > 0 Then
          strSubject = Replace(strSubject, olPrefix(i), olReplace(i), vbTextCompare)
          Exit For
        End If
    Next
    
   item.Subject = Trim(strSubject)
   item. Save
End Sub

Another way would be to OR the two instr lines and put both replaces in the IF. (I did not test this one.)

Oh, and I would check for the colon too - not just the letters because it will find AW within a word - and your replace has the colon. (It's case-sensitive but there is always a chance someone will type all caps in the subject.)

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String

If InStr(Item.Subject, "AW:") > 0 OR InStr(Item.Subject, "WG:") > 0 Then

If MsgBox("Do you want to remove the AW or WG prefix?", vbYesNo) = vbYes Then
strSubject = Replace(Item.Subject, "AW:", "Re:", vbTextCompare)
strSubject = Replace(Item.Subject, "WG:", "Fwd:", vbTextCompare)
End if
Else
strSubject = Item.Subject
End If

Item.Subject = Trim(strSubject)
Item.Save
End Sub