在 Excel 中打开 Outlook 模板时删除签名

Question

我正在尝试从 Excel 打开 Outlook 模板 (.oft) 文件，但未附加用户签名。我无法让它工作。

我知道我需要删除隐藏的书签“_MailAutoSig”，但我不知道怎么做。我已尝试遵循本指南，但它已过时且不适用于 Outlook / Excel 2016：https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2007/dd492012(v=office.12)#176-working-with-outlook-signatures

这是我的代码

Option Explicit

Sub openEmail()

Dim cfgFromEmail As String
Dim cfgNotice As String
Dim cfgTemplate As String
Dim appOutlook As Outlook.Application
Dim newEmail As Outlook.MailItem

Dim rownum As Integer
Dim colnum As Integer

rownum = 6

cfgFromEmail = Sheets("Email").Range("O5").Value
cfgNotice = Sheets("Email").Cells(rownum, 10) '10 = column J
cfgTemplate = Sheets("Email").Cells(rownum, 11) '11 = column K

Set appOutlook = CreateObject("Outlook.Application")
Set newEmail = appOutlook.CreateItemFromTemplate("\\location\to\template\" & cfgTemplate & ".oft")
'Set template = mailApp.CreateItem(olMailItem) 'Creates a blank email

If cfgNotice <> "null" Then 'If is not blank
    MsgBox cfgNotice, vbInformation, "Before you send the email"
End If

With newEmail
    .SentOnBehalfOfName = cfgFromEmail
    .Display 'Show the email

End With

Set newEmail = Nothing
Set appOutlook = Nothing

End Sub

非常感谢任何帮助。我花了几个小时搜索 Google 和 Stack Overflow 都没有运气。

Answer 1

如果电子邮件模板不是太复杂，您可以只创建一个新电子邮件并使用 HTML 创建无需签名的模板：

Sub emailgenerator

    Dim appOutlook As Outlook.Application
    Dim newEmail As Outlook.MailItem
    Dim emailBody As String

    Set appOutlook = CreateObject("Outlook.Application")
    Set newEmail = olApp.CreateItem(olMailItem)

    emailBody = "<p>Header</p><br><p>body area or something</p>"
    emailBody = emailBody & "<table></table>" ' maybe add tables and whatever is needed

    With newEmail 
        .To = "abc@abc.com"
        .CC = "def@def.com"
        .Subject = "Test"
        .SentOnBehalfOfName = "youremail@youremail.com" ' could disregard this
        .HTMLBody = emailBody
        .Save
        .Close olPromptForSave
    End With

End Sub

这需要对 HTML 进行一些研究，但您或许可以通过足够的努力重新创建模板。

我相信当我为另一个项目尝试这种方法时，我的签名没有像使用模板那样自动附加，但不确定......祝你好运

Answer 2

感谢this stack overflow post，我找到了解决方案

我们需要将模板保存为 HTML，然后使用 HTML 代码手动创建新电子邮件。

我尚未将图像添加到代码中，但我认为使用查找和替换方法会很容易。

没有图片的最终代码：

Option Explicit

Sub openEmail(rownum As Integer)

Dim cfgFromEmail As String
Dim cfgNotice As String
Dim cfgTemplate As String
Dim appOutlook As Outlook.Application
Dim newEmail As Outlook.MailItem
Dim htmlPath As String

'Dim rownum As Integer
'Dim colnum As Integer

'rownum = 6

cfgFromEmail = Sheets("Email").Range("O5").Value
cfgNotice = Sheets("Email").Cells(rownum, 10) '10 = column J
cfgTemplate = Sheets("Email").Cells(rownum, 11) '11 = column K
htmlPath = "\\shared\drive\path\to\template\goes\here\" & cfgTemplate & ".htm"

Set appOutlook = CreateObject("Outlook.Application")
Set newEmail = appOutlook.CreateItem(olMailItem) 'Creates a blank email

If cfgNotice <> "null" Then 'If is not blank
    MsgBox cfgNotice, vbInformation, "Before you send the email"
End If

With newEmail
    .SentOnBehalfOfName = cfgFromEmail
    .HTMLBody = HTMLtoString(htmlPath)
    'Refer to and fill in variable items in template
    '.Body = Replace(.Body, "<< clientname >>", Worksheets("Clients").Range(1, 2))
    '.HTMLBody = Replace(.HTMLBody, "&lt;&lt; clientname &gt;&gt;", Worksheets("Clients").Range(1, 2))
    .Display 'Show the email

End With

Set newEmail = Nothing
Set appOutlook = Nothing

End Sub

Function HTMLtoString(htmlPath As String)
    'Returns a string after reading the contents of a given file
    HTMLtoString = CreateObject("Scripting.FileSystemObject").OpenTextFile(htmlPath).ReadAll()

End Function

Answer 3

如果有人正在寻找不涉及解析 HTML 标签的解决方案，这里有一个相对简单的解决方案。确保引用了 Microsoft Word 库。

Dim myItem As Outlook.MailItem
Dim myInspector As Outlook.Inspector
Dim myDoc As Word.Document

Set myItem = _
    Outlook.Application.CreateItemFromTemplate(TemplateName & ".oft")

    .Display
    Set myInspector = Application.ActiveInspector
    Set myDoc = myInspector.WordEditor

 myDoc.Bookmarks("_MailAutoSig").Range.Delete