首页 文章

将电子邮件设置为对同一电子邮件主题的回复[1]

提问于
浏览 次
0

这个问题已经在这里有了答案：

以前，我已经成功地(在 PEH 的帮助下)创建了一个宏，该宏将地址电子邮件和工作簿附加到正确的发件人。该代码位于以下链接地址动态确定的单元格的返回值中，我也将在下面粘贴。

我的经理现在要我在此宏下附加特定电子邮件主题的对话(答复的历史记录)。因此，当收件人从发件人处收到电子邮件并按按钮进行答复时，该电子邮件应附加到相同的“电子邮件主题”并添加两方之间的历史记录，而不仅仅是工作簿文档。

我找到了这个Excel VBA，如何回复特定的电子邮件，但是我不明白如何将其设置为自己的代码。

可以针对现有内容执行此操作，还是应该更改代码的结构？

Sub mail()

Dim A As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim wb As Workbook

Dim check

Set wb = Excel.ActiveWorkbook
Set sh1 = wb.Worksheets(1)
Set sh2 = wb.Worksheets(2)

For A = 2 To sh1.Cells(Rows.Count, "A").End(xlUp).Row
    check = Application.match(sh1.Cells(A, 1).Value, sh2.Columns(1), 0)

    If IsError(check) And Not IsEmpty(sh1.Cells(A, 1)) Then
        MsgBox "No email was found!"
    Else
        h = sh2.Cells(check, 2).Value

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.createItem(olmailitem)
        Set wb2 = ActiveWorkbook
        wb.Save

        With OutMail
            .Display
            .To = h
            .cc = ""
            .BCC = ""
            .Subject = "Test - " 
            .htmlbody = "<p style='font-family:calibri;font-size:15'>" & "Hi " & C & "<BR/>" & "<BR/>" & "Please check the attached template." & "
" & "<BR/>" & "Change data if required." & "<BR/>" & "
" & "This e-mail has been automatically send! " & "
" & "
" & "With best regards," & "
" & "
"
            .attachments.Add wb2.FullName
        End With

        wb.Close
    End If
Next

End Sub
excel vba excel-vba outlook-vba

2 回答

  • 0

    代替使用OutApp.createItem(olmailitem)，而是使用当前选择的电子邮件(OutApp.ActiveExplorer.Selection(1))并在其上调用 Reply-它将返回一个新的 MailItem 对象，该对象具有适当填充的主题，正文和收件人。您只需要将文件附加到它。

    Set OutMail = OutApp.ActiveExplorer.Selection(1).Reply
Set wb2 = ActiveWorkbook
wb.Save
With OutMail
   .attachments.Add wb2.FullName
   .Display
End With
    回复于
  • 1

    您可以使用.Find方法来查找特定主题，然后可以回答该主题(如果已找到)或创建新电子邮件(如果未找到该主题)。

    Sub mail()

    Dim A As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim wb As Workbook

    Dim check

    Set wb = Excel.ActiveWorkbook
    Set sh1 = wb.Worksheets(1)
    Set sh2 = wb.Worksheets(2)

    For A = 2 To sh1.Cells(Rows.Count, "A").End(xlUp).Row
        check = Application.Match(sh1.Cells(A, 1).Value, sh2.Columns(1), 0)

        If IsError(check) And Not IsEmpty(sh1.Cells(A, 1)) Then
            MsgBox "No email was found!"
        Else
            h = sh2.Cells(check, 2).Value

            Set OutApp = CreateObject("Outlook.Application")

            'check if we can answer
            Dim OutNs As Namespace
            Set OutNs = OutApp.GetNamespace("MAPI")
            Dim OutFldr As MAPIFolder
            Set OutFldr = OutNs.GetDefaultFolder(olFolderInbox) 'default inbox folder (where we want to search for the subject)

            Dim OutMail As Variant
            Set OutMail = OutFldr.Items.Find("[Subject] = """ & "YOUR SUBJECT YOU WANT TO ANSWER TO" & """") 'search for specific subject
            If Not (OutMail Is Nothing) Then
                'we found something to reply to
                OutMail.Reply
            Else
                'we found nothing … so create new mail
                Set OutMail = OutApp.CreateItem(olMailItem)
            End If

            Set wb2 = ActiveWorkbook
            wb.Save

            With OutMail
                .Display
                .To = h
                .CC = ""
                .BCC = ""
                .Subject = "Test - "
                .HTMLBody = "<p style='font-family:calibri;font-size:15'>" & "Hi " & c & "<BR/>" & "<BR/>" & "Please check the attached template." & "
    " & "<BR/>" & "Change data if required." & "<BR/>" & "
    " & "This e-mail has been automatically send! " & "
    " & "
    " & "With best regards," & "
    " & "
    "
                .Attachments.Add wb2.FullName
            End With

            wb.Close
        End If
    Next

End Sub
    回复于

相关问题