Excel VBA Logic的想法

时间:2018-01-22 21:41:54

标签: vba excel-vba excel

我的脚本用于跟踪主题和收到时间的电子邮件。 我每天收到4封电子邮件,我需要报告收到电子邮件的时间。 我的问题是我创建了复选框,允许我想要跟踪哪些电子邮件,但我不知道如何在逻辑上进行。首先我试过,我创建了15个if语句。我知道这不好,所以我在寻找新的逻辑。我在下面附上了我的代码。 请分享您的知识。

另外,限制方法适用于指定日期和发件人。

enter image description here

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

0 个答案:

没有答案