我将从客户端收到日记条目,并需要回复同一邮件。
我已经尝试过以下代码来执行对邮件链的回复。但代码返回包含相同主题行的所有邮件。
我需要回复最近发布的内容。我尝试了很多解决方案,但我无法修复它。
如何根据主题,收到的时间和日期回复电子邮件
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
答案 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 Method对Items集合应用过滤器,返回一个新集合,其中包含原始中与过滤器匹配的所有项目。
编辑 - 完整代码
ubuntu/<Your username>