Subject not being replaced by VBA Macro

Question

Okay so, I'm trying to edit this code I found that allows me to input variable information into a pop up box for emails. This is great and works flawlessly (although kinda slow), however I'm running into a weird issue trying to do the same thing with the subject line as well.

Using one template that I have set up, working template I get exactly what I'm looking for, it goes through all 4 of the variables INCLUDING the one on the subject line.

However, if I use a different template with the same variables, Not working template, it doesn't replace the subject line. The other two variables in the broken template pop up the dialog box - example

Can someone help fill me in on why it works on one template but not the other?

Full code:

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
If TypeOf Inspector.CurrentItem Is Outlook.MailItem Then
'Handle emails only
Set m_Inspector = Inspector
End If
End Sub

Private Sub m_Inspector_Activate()

Dim Item As MailItem
Dim Value As String

If TypeOf m_Inspector.CurrentItem Is MailItem Then

Set mail = m_Inspector.CurrentItem

'Identify the message subject
If mail.Subject = "FMAudit Legacy Install [custbusiness]" Or mail.Subject = "FMAudit Install [custbusiness]" Then
 
    'Check message format
    If mail.BodyFormat = OlBodyFormat.olFormatPlain Then

        'Replace [date] with the entered value
        If InStr(mail.Body, "[custname]") > 0 Then
         Value = InputBox("Enter the customer name")
     
         If Value <> "" Then
          mail.Body = Replace(mail.Body, "[custname]", Value)
         End If
        End If
     
        'Replace [percent] with the entered value
        If InStr(mail.Body, "[custbusiness]") > 0 Then
           Value = InputBox("Enter business name")
     
         If Value <> "" Then
            mail.Body = Replace(mail.Body, "[custbusiness]", Value)
         End If
        End If
        
        'Replace [percent] with the entered value
        If InStr(mail.Body, "[custhost]") > 0 Then
           Value = InputBox("Enter host name")
     
         If Value <> "" Then
            mail.Body = Replace(mail.Body, "[custhost]", Value)
         End If
        End If
     
    Else
         
        'Replace [date] with the entered value
        If InStr(mail.HTMLBody, "[custname]") > 0 Then
         Value = InputBox("Enter the customer name")
     
         If Value <> "" Then
          mail.HTMLBody = Replace(mail.HTMLBody, "[custname]", Value)
         End If
        End If
     
        'Replace [percent]; with the entered value
        If InStr(mail.HTMLBody, "[custbusiness]") > 0 Then
           Value = InputBox("Enter business name")
     
         If Value <> "" Then
            mail.HTMLBody = Replace(mail.HTMLBody, "[custbusiness]", Value)
         End If
        End If
        
        'Replace [percent]; with the entered value
        If InStr(mail.HTMLBody, "[custhost]") > 0 Then
           Value = InputBox("Enter host name")
     
         If Value <> "" Then
            mail.HTMLBody = Replace(mail.HTMLBody, "[custhost]", Value)
            
        'Replace [percent] with the entered value
        If InStr(mail.Subject, "[custbusiness]") > 0 Then
           Value = InputBox("Enter business name subject")
     
         If Value <> "" Then
            mail.Subject = Replace(mail.Subject, "[custbusiness]", Value)
         End If
        End If
        
         End If
        End If
     
    End If

End If

Set mail = Nothing

End If
End Sub

Maybe the non-working template is in format OlBodyFormat.olFormatPlain and the working one is not? Only the latter has code to replace the subject placeholder... — Tim Williams

Tim Williams Tim Williams · Accepted Answer · 2022-03-09T18:27:03

Your code could be simplified a lot by creating a separate method which just does the replacements:

Option Explicit

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
    Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
    If TypeOf Inspector.CurrentItem Is Outlook.MailItem Then
        Set m_Inspector = Inspector 'Handle emails only
    End If
End Sub

Private Sub m_Inspector_Activate()
    Dim mail As MailItem
    
    If TypeOf m_Inspector.CurrentItem Is MailItem Then
    
        Set mail = m_Inspector.CurrentItem
        'Check the message subject
        If mail.Subject = "FMAudit Legacy Install [custbusiness]" Or _
           mail.Subject = "FMAudit Install [custbusiness]" Then
         
            ReplaceTags mail, "[custname]", "Enter the customer name"
            ReplaceTags mail, "[custbusiness]", "Enter business name"
            ReplaceTags mail, "[custhost]", "Enter host name"
        
        End If    'matched subject line
    End If        'is a mail item
End Sub

'replace tag `sTag` with user-supplied value in `mail` body and subject
Sub ReplaceTags(mail As MailItem, sTag As String, sPrompt As String)
    Dim v, oBody As Object
    'Check message format and get the body object
    If mail.BodyFormat = OlBodyFormat.olFormatPlain Then
        Set oBody = mail.Body
    Else
        Set oBody = mail.HTMLBody
    End If
    If InStr(oBody, sTag) > 0 Then             'check Body Text
        v = Trim(InputBox(sPrompt))
        If Len(v) > 0 Then oBody = Replace(oBody, sTag, v)
    End If
    If InStr(mail.Subject, sTag) > 0 Then      'check Subject text
        If Len(v) = 0 Then v = Trim(InputBox(sPrompt)) 'don't re-prompt if already have a value
        If Len(v) > 0 Then mail.Subject = Replace(mail.Subject, sTag, v)
    End If
End Sub

Subject not being replaced by VBA Macro

1 Answers