首页 > 解决方案 > 回复选定的电子邮件并从可用签名中进行选择

问题描述

我向选定的电子邮件发送带有指定签名的标准回复。

我对我的签名名称进行了硬编码,但想动态选择签名。

我有:

Sub Mail_Outlook_With_Signature_Html_2()
    Dim SigString As String
    Dim Signature As String
    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' Reply
    Dim olRecip As Recipient ' Add Recipient

    'Change Response1.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\1.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next
   
    For Each olItem In Application.ActiveExplorer.Selection
        Set olReply = olItem.ReplyAll
        Set olRecip = olReply.Recipients.Add(" ") ' Recipient Address
        olRecip.Type = olCC
        olReply.HTMLBody = Signature & olReply.HTMLBody
        olReply.Display

        'olReply.Send
    Next olItem
End Sub

Function GetBoiler(ByVal sFile As String) As String<br>
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

我有 10 家供应商要跟进。
我不想对他们每个人都回复并选择签名,而是想一口气用签名回复所有人。
目前,该代码仅适用于名为“1.htm”的签名,我可以手动更改该签名,但我想选择用于响应的签名。这样,程序变得更加通用。

有没有办法可以选择 .htm 文件(类似于 Excel VBA 中的文件资源管理器)并将该名称提供给 SigString?

标签: vbaoutlook

解决方案


Option Explicit

Sub Mail_Outlook_With_Signature_BasedOnAddress()

Dim sigString As String
Dim Signature As String

Dim olItem As Object
Dim olReply As MailItem     ' Reply
Dim olRecip As Recipient    ' Add Recipient

If ActiveExplorer.Selection.Count > 0 Then

    sigString = Environ("appdata") & "\Microsoft\Signatures\"
    
    For Each olItem In ActiveExplorer.Selection
    
        If olItem.Class = olMail Then
        
            Set olReply = olItem.replyall
                        
            If olItem.SenderEmailAddress = "Address1@somewhere.com" Then
                sigString = sigString & "1.htm"
    
            ElseIf olItem.SenderEmailAddress = "Address2@somewhere.com" Then
                sigString = sigString & "2.htm"
                
            ' ...
            
            Else
                sigString = sigString & "standardReply.htm"
                
            End If
            
            Signature = GetBoiler_IfFileExists(sigString)
            
            olReply.HTMLBody = Signature & olReply.HTMLBody
            olReply.Display
            'olReply.Send
            
        End If
        
    Next olItem
    
End If

End Sub


Function GetBoiler_IfFileExists(ByVal sFile As String) As String

Dim fso As Object
Dim ts As Object

If dir(sFile) <> "" Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler_IfFileExists = ts.ReadAll
    ts.Close
    
Else
    GetBoiler_IfFileExists = ""
    
End If

End Function

推荐阅读