根据主题,收到的时间和日期回复Outlook邮件

时间:2018-03-09 18:27:41

标签: vba excel-vba outlook outlook-vba excel

我将从客户端收到日记条目,并需要回复同一邮件。

我已经尝试过以下代码来执行对邮件链的回复。但代码返回包含相同主题行的所有邮件。

我需要回复最近发布的内容。我尝试了很多解决方案,但我无法修复它。

如何根据主题,收到的时间和日期回复电子邮件

Sub mail()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olFldr As MAPIFolder
Dim olMail ' As Outlook.MailItem


Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set olFldr = Fldr
 For Each olMail In olFldr.Items

      If InStr(olMail.Subject, Range("C2")) <> 0 Then
        Set ReplyAll = olMail.ReplyAll
        With ReplyAll
            .HTMLBody = "<font size=""3"" face=""Calibri"">" & _
              "Hi Veronica <br><br>" & _
              "The " & _
               Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) & "</B> has been posted.<br>" & _
               "<br><br>Regards," & _
              "<br><br>Rajesh</font>" & .HTMLBody

            emailReady = True
            .Display
        End With
    End If
Next olMail
If Not emailReady Then
i = i + 1
If i > Fldr.Folders.Count Then
    MsgBox ("The email with the given subject line was not found!")
    Exit Sub
Else
    Set olFldr = Fldr.Folders(i)
    GoTo tryAgain
End If
End If

End Sub

1 个答案:

答案 0 :(得分:0)

使用 Items.Restrict Method (Outlook) 按主题和日期过滤&amp;时间

确保将您的主题Option Explicit Public Sub Example() Dim olApp As Outlook.Application Set olApp = New Outlook.Application Dim olNs As Outlook.Namespace Set olNs = olApp.GetNamespace("MAPI") Dim Inbox As Outlook.MAPIFolder Set Inbox = olNs.GetDefaultFolder(olFolderInbox) Dim Subject As String Subject = ThisWorkbook.Sheets("Sheet1").Range("C2").Text Debug.Print Subject Dim i As Long Dim Filter As String Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _ Chr(34) & " >= '02/20/2018' And " & _ Chr(34) & "urn:schemas:httpmail:datereceived" & _ Chr(34) & " < '02/25/2018' And " & _ Chr(34) & "urn:schemas:httpmail:subject" & _ Chr(34) & "Like '%" & Subject & "%'" Dim Items As Outlook.Items Set Items = Inbox.Items.Restrict(Filter) Items.Sort "[ReceivedTime]" For i = Items.Count To 1 Step -1 DoEvents If TypeOf Items(i) Is mailitem Then Dim Item As Object Set Item = Items(i) Debug.Print Item.Subject ' Print on Immediate Window Debug.Print Item.ReceivedTime ' Print on Immediate Window End If Next End Sub 转换为string variable then use it on your filter

实施例

Option Explicit
Public Sub Example()
    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application

    Dim olNs As Outlook.Namespace
    Set olNs = olApp.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Dim Subject As String
        Subject = ThisWorkbook.Sheets("Sheet1").Range("C2").Text
        Debug.Print Subject

    Dim i As Long
    Dim Filter As String
        Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & _
                           Chr(34) & " >= '03/07/2018' And " & _
                           Chr(34) & "urn:schemas:httpmail:datereceived" & _
                           Chr(34) & " < '03/25/2018' And " & _
                           Chr(34) & "urn:schemas:httpmail:subject" & _
                           Chr(34) & "Like '%" & Subject & "%'"

    Dim Items As Outlook.Items
    Set Items = Inbox.Items.Restrict(Filter)
        Items.Sort "[ReceivedTime]"

    For i = Items.Count To 1 Step -1
        DoEvents
        If TypeOf Items(i) Is MailItem Then
            Dim Item As Object
            Set Item = Items(i)
            Debug.Print Item.Subject ' Print on Immediate Window
            Debug.Print Item.ReceivedTime ' Print on Immediate Window

            Dim ReplyAll As Outlook.MailItem
            Set ReplyAll = Item.ReplyAll

            With ReplyAll
                .HTMLBody = "<font size=""3"" face=""Calibri"">" & _
                  "Hi Veronica <br><br>" & _
                  "The " & Left(ActiveWorkbook.name, _
                          InStr(ActiveWorkbook.name, ".") - 1) & _
                  "</B> has been posted.<br>" & _
                  "<br><br>Regards," & _
                  "<br><br>Rajesh</font>" & .HTMLBody

                .Display
            End With

        End If
    Next

End Sub
  

Items.Restrict MethodItems集合应用过滤器,返回一个新集合,其中包含原始中与过滤器匹配的所有项目。

     

编辑 - 完整代码

ubuntu/<Your username>

https://stackoverflow.com/a/43622710/4539709