时间戳

首页 > 解决方案 > 通过 Outlook 中的宏写入电子邮件添加默认电子邮件签名

vba - 通过 Outlook 中的宏写入电子邮件添加默认电子邮件签名

问题描述

我正在尝试在 Outlook 中编写一个宏，当我单击“新邮件”按钮时，它会提示输入附件。当我选择附件时，它会读取它的名称，并将该名称放在主题和正文中。

目前，我能够执行上述任务，但有一些小问题，我希望能得到一些帮助。截至目前，当我被提示输入附件时，我选择了它，但它要求我第二次这样做。然后它将仅使用第二个附件作为信息并实际附加到电子邮件中。我的第二个问题是，我不知道如何让电子邮件在编写宏时在末尾添加默认签名。

在星期五之前我从未使用过 VBA，而且编码经验很少，所以我希望有人能提供帮助。我从其他地方复制了一些代码，然后在其上构建，所以我知道它可能是混乱的，而不是最干净的代码。

Sub CreateNewMail()
Dim obApp As Object
Dim NewMail As MailItem
Dim otherObject As Word.Application
Dim fd As Office.FileDialog
Dim fileaddress As String
Dim filename As String
Dim signature As String

Set obApp = Outlook.Application
Set NewMail = obApp.CreateItem(olMailItem)


'Set to use Word for Attach File Dialog
Set otherObject = New Word.Application
otherObject.Visible = False

Set fd = otherObject.Application.FileDialog(msoFileDialogFilePicker)

With fd
.AllowMultiSelect = False
.InitialFileName = "\\atro1\users\tdomanski\scan"
.Show
End With

fd.Show

fileaddress = fd.SelectedItems(1)

'Aquire File Name in correct form for Subject Line
Dim MidStart As Long
MidStart = InStrRev(fileaddress, "\") + 1

Dim MidEnd As Long
MidEnd = InStrRev(fileaddress, ".")

filename = Mid(fileaddress, MidStart, MidEnd - MidStart)



htmlbody1 = "<HTML><Body><p>Good Afternoon,</p><p>Please confirm receipt of attached "
htmlbody2 = "<br/>Please either email an order acknowledgement to me or initial & fax back PO to 716-655-0309.<p>Also, we are striving for 100% on-time delivery of purchase orders.  If you cannot meet the required delivery date on the PO, please contact me as soon as possible.</p><p>Thank you!</p></body></html>"

'You can change the concrete info as per your needs
With NewMail
     .Subject = filename
     .BodyFormat = olFormatHTML
     .HTMLBody = (htmlbody1 + filename + htmlbody2)
     .Attachments.Add ((fileaddress))
     .Display
End With
signature = oMail.HTMLBody
Set obApp = Nothing
Set NewMail = Nothing

End Sub

标签： vbaemailoutlook

解决方案

将默认签名添加到邮件中有点棘手。一旦我想这样做，但找不到简单的解决方案。所以我想出了一个绕道而行的方法来实现这一点。第一个过程所做的是在草稿文件夹中创建和保存邮件。此邮件中没有正文，因此如果存在，它会以某种方式添加默认签名。

Public Sub SendAnEmail()
Dim Poczta As New Outlook.Application
Dim mojMail As MailItem
Dim Subj As String

Subj = "Test"

Set Poczta = CreateObject("outlook.application")
Set mojMail = Poczta.CreateItem(0)
    With mojMail
        .To = "ddddd@www.com"
        .Subject = Subj
        .ReadReceiptRequested = False
        .OriginatorDeliveryReportRequested = False
        '.Body = sign
        .Display
        '.Send
        .Save

    End With

End Sub

然后在每个循环中，我们从草稿和连接字符串中读取邮件。第一个字符串是一个正文邮件，此时假设是您的签名，您可以将其与任何您想要的内容连接起来。

Sub Drafts()

Dim DraftFold As Outlook.Folder
Dim item As MailItem
Dim sign As String

Set DraftFold = 
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)

For Each item In DraftFold.Items
    sign = item.Body
Next item

Dim Poczta As New Outlook.Application
Dim mojMail As MailItem

Dim Subj As String
Dim Text As String


Subj = "Test"

Text = "Anything"

Set Poczta = CreateObject("outlook.application")
Set mojMail = Poczta.CreateItem(0)
    With mojMail
        .To = "ddddd@www.com"
        .Subject = Subj
        .ReadReceiptRequested = False
        .OriginatorDeliveryReportRequested = False
        .Body = sign
        .Display
        '.Send

    End With

End Sub

好吧，我知道这不是一个很好的解决方案，但是如果您找不到更好的解决方案，请尝试使用它。

推荐阅读