Question

我正在尝试在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

Answer 1

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

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

然后在每个循环中我们从草稿和连接字符串中读取邮件。第一个字符串是一个Body邮件，在这一刻它被认为是你的签名，你可以用你想要的任何东西来连接它。

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

嗯，我知道这不是一个很好的解决方案，但如果你没有找到更好的尝试来解决这个问题。

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

1 个答案: