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

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

3 个答案: