我的脚本用于跟踪主题和收到时间的电子邮件。 我每天收到4封电子邮件,我需要报告收到电子邮件的时间。 我的问题是我创建了复选框,允许我想要跟踪哪些电子邮件,但我不知道如何在逻辑上进行。首先我试过,我创建了15个if语句。我知道这不好,所以我在寻找新的逻辑。我在下面附上了我的代码。 请分享您的知识。
另外,限制方法适用于指定日期和发件人。
Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim OutlookMail As Variant
Dim Folder As MAPIFolder
Dim olItems As Outlook.Items
Dim myItems As Outlook.Items
Dim olShareName As Outlook.Recipient
Dim dStart As Date
Dim dEnd As Date
Dim i As Integer
Dim sFilter As String
Dim sFilterLower As String
Dim sFilterUpper As String
Dim sFilterSender As String
'========================================================
'access to shared mailbox to get items
'========================================================
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set olShareName = OutlookNamespace.CreateRecipient("Mailbox.teamshared@example.ca")
Set Folder = Session.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("subfolder1").Folders("subfolder2")
Set olItems = Folder.Items
'========================================================
'If check box is checked
'========================================================
dStart = Range("From_Date").Value
dEnd = Range("To_Date").Value
'========================================================
'Conditions for restrict to get items specificed date
'========================================================
sFilterLower = "[ReceivedTime] > '" & Format(dStart, "ddddd h:nn AMPM") & "'"
sFilterUpper = "[ReceivedTime] < '" & Format(dEnd, "ddddd h:nn AMPM") & "'"
sFilterSender = "[SenderName] = ""no-reply@example.com"""
'========================================================
'Restrict emails followed by above conditions
'========================================================
Set myItems = olItems.Restrict(sFilterLower)
Set myItems = myItems.Restrict(sFilterUpper)
Set myItems = myItems.Restrict(sFilterSender)
'========================================================
'items(emails) display in worksheets
'========================================================
i = 1
For Each myItem In myItems
Range("eMail_subject").Offset(i, 0).Value = myItem.Subject
Range("eMail_date").Offset(i, 0).Value = Format(myItem.ReceivedTime, "h:nn")
'Convert size KB
If myItem.Attachments.Count > 0 Then
Range("eMail_size").Offset(i, 0).Value = myItem.Attachments.Item(1).Size / 1024
Else
Range("eMail_size").Offset(i, 0).Value = "No attached file"
End If
i = i + 1
Next myItem
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
Else
MsgBox "You have check at least one"
End If
End Sub