主题未被 VBA 宏替换

Question

好吧，我正在尝试编辑这段代码，我发现它允许我将变量信息输入到电子邮件的弹出框中。这很棒并且工作完美（虽然有点慢），但是我在尝试对主题行做同样的事情时遇到了一个奇怪的问题。

使用我设置的一个模板，工作模板我得到了我正在寻找的东西，它会遍历所有 4 个变量，包括主题行中的变量。

但是，如果我使用具有相同变量的不同模板，不工作模板，它不会t 替换主题行。损坏的模板中的另外两个变量弹出对话框 - 示例

有人可以帮我填写吗为什么它适用于一个模板但不适用于另一个模板？

完整代码：

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

Answer 1

通过创建一个仅执行替换的单独方法，可以大大简化您的代码：

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