Question

如果有符合我设置条件的电子邮件，我有这个函数循环遍历我的 Outlook收件箱并返回Boolean作为最终结果。即使条件错误，该函数也始终返回true。我将.Sender替换为xxxxxxx，它也会返回True。

GetSMTPAddressForRecipients来自MSDN仅将Sub更改为Function GetSMTPAddressForRecipients(mail As Outlook.MailItem)

我做错了什么？

Function CheckInbox(ByVal fpemail As Variant) As Boolean

CheckInbox = False

Dim objOutlook As Object, objNamespace As Object, objFolder As Object
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")

On Error Resume Next
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)

Dim tdyDate As Date
Dim checkDate As Date
tdyDate = Format(Now(), "Short Date")
checkDate = DateAdd("d", -7, tdyDate) ' DateAdd(interval,number,date)

 Dim iCount As Integer, DateCount As Integer
 EmailCount = objFolder.Items.Count
 DateCount = 0

 ' loop the mailbox
 For iCount = 1 To EmailCount
 'check for sender.email type first, mine is 'EX'
 With objFolder.Items(iCount)
    If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) >= checkDate And _
       DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) <= tdyDate And _
       .Subject Like "Test Subject" And _
       .Sender.GetExchangeUser.PrimarySmtpAddress = "xxxxxxx" And _
       GetSMTPAddressForRecipients(.To) = fpemail Then
       CheckInbox = True
       Exit Function
    Else
       CheckInbox = False
    End If
 End With
 Next iCount

Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing

End Function

Answer 1

您可能需要考虑以下事项：

首先进行早期绑定以确保您正确访问这些属性。
您如何做到这一点？只需在工具＆gt;参考下添加对 Outlook库的引用。

Microsoft Outlook XX.0对象库

现在，请确保您使用的是 Outlook MailItem对象。您可以尝试在循环中插入一个检查。一些事情：

Dim objItem As Outlook.MailItem '/* add declaration to make use of intellisense */

'/* backward loop, but starts with most recent email */
For iCount = EmailCount To 1 Step -1 
    ' check for sender.email type first, mine is 'EX'
    If TypeOf objFolder.Items(iCount) Is MailItem Then
        Set objItem = objFolder.Items(iCount)
        With objItem
            '...rest of code here

        End With
    End if
Next

我不知道，但你先发表评论来检查类型，但从未见过代码，所以我检查了项目的类型。

您不需要使用DateSerial和所有其他功能来比较日期。你可以简单地说：
```
If Format(.ReceivedTime, "Short Date") >= checkdate Then
```
我不知道您是否正在使用字符串Subject测试Test Subject或等于它。首先，我认为应该是：
```
And .Subject Like "*Test Subject*"
```
上面返回所有主题，其中包含测试主题。或者更好的是：
```
And Instr(.Subject, "Test Subject") <> 0 
```
如果您尝试MailItem Subject等于测试主题，那么只需使用：
```
And .Subject = "Test Subject"
```
确保您实际上正在检索此内容（应该是电子邮件地址）。
```
.Sender.GetExchangeUser.PrimarySmtpAddress
```
GetSMTPAddressForRecipients程序需要MailItem，但您提供了MailItem 至属性（您说您按原样使用它并只是转换它一个功能）。请注意，该过程将使MailItem中的所有收件人都接受测试。为什么首先需要 SMTP地址？我建议你用这个名字？一些事情：
```
And Instr(.To, "John Doe") <> 0 
```
其中 John Doe 是指定名称的收件人。

重构你的功能：

Function CheckInbox(ByVal fpemail As String) As Boolean

    Dim objOutlook As Outlook.Application 'As Object
    Dim objNamespace As Outlook.Namespace 'As Object
    Dim objFolder As Outlook.Folder 'As Object
    '/* added declarations */
    Dim objItem As Outlook.MailItem
    Dim objRecip As Outlook.Recipient
    Dim EmailCount As Integer

    '/* I assumed Outlook is already running, revert to your code other wise */    
    Set objOutlook = GetObject(, "Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")

    Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)

    Dim tdyDate As Date
    Dim checkDate As Date
    tdyDate = Format(Now(), "Short Date")
    checkDate = DateAdd("d", -7, tdyDate)

    Dim iCount As Integer, DateCount As Integer
    EmailCount = objFolder.Items.Count
    DateCount = 0

    '/* loop the mailbox, same as your code */
    For iCount = EmailCount To 1 Step -1
        '/* Check for the type */
        If TypeOf objFolder.Items(iCount) Is MailItem Then
            '/* Set the object, get intellisense */
            Set objItem = objFolder.Items(iCount)
            With objItem
               If Format(.ReceivedTime, "Short Date") >= checkDate _
               And Format(.ReceivedTime, "Short Date") <= tdyDate _
               And InStr(.Subject, "Test Subject") <> 0 _
               And .Sender.GetExchangeUser.PrimarySmtpAddress = "xxxxxxx" _
               And EvaluateRecipientSMTP(.Recipients, fpemail) Then
               '/* we use below function here */ 
                  CheckInbox = True
                  Exit Function
               Else
                  CheckInbox = False
               End If
            End With
        End If
    Next iCount

    Set objFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing

End Function

编辑1：额外功能

Private Function EvaluateRecipientSMTP(objAllRecip As Outlook.Recipients, _
                                       fpemail As String) As Boolean

    Dim objRecip As Outlook.Recipient
    Dim objExUser As Outlook.ExchangeUser
    Dim objExDisUser As Outlook.ExchangeDistributionList

    For Each objRecip In objAllRecip
        Select Case objRecip.AddressEntry.AddressEntryUserType
        '/* OlAddressEntryUserType.olExchangeUserAddressEntry or
        'OlAddressEntryUserType.olOutlookContactAddressEntry */
        Case 0, 10
            Set objExUser = objRecip.AddressEntry.GetExchangeUser
            If Not objExUser Is Nothing Then
                If objExUser.PrimarySmtpAddress = fpemail Then
                    EvaluateRecipientSMTP = True
                    Exit For
                End If
            End If
        '/* OlAddressEntryUserType.olExchangeDistributionListAddressEntry */
        Case 1
            Set objExDisUser = objRecip.AddressEntry.GetExchangeDistributionList
            If Not objExDisUser Is Nothing Then
                If objExDisUser.PrimarySmtpAddress = fpemail Then
                    EvaluateRecipientSMTP = True
                    Exit For
                End If
            End If
        '/* recipient not part of your exchange server */
        Case Else
        '/* Do nothing */
        End Select
    Next
End Function

重要：

上面的
fpemail类型为String，这是您要查找的收件人姓名。

对于上面的第5项，您可能需要考虑YowE3K's建议。

不要忘记设置参考。

VBA函数始终返回TRUE

1 个答案: