Question

您好，我想检索从2017年6月29日到今天的所有电子邮件，但我只保存了从今天到2018年7月31日的MS访问权限，这代表了过去23天。我的收件箱中有超过 7345封电子邮件。

我的错误是循环刚超过第350封电子邮件就停止了

Sub log_your_inbox_to_ms_access()

    'our Outlook folder- deifinitions
    Dim myItem As MailItem
    Dim myFolder As Folder
    Dim myNamespace As NameSpace
    Set myNamespace = Application.GetNamespace("MAPI")
    'put your folders name here
    'second is possibly 'inbox folder'
    Set myFolder = myNamespace.Folders("GiftCard").Folders("Inbox")

    ' Set up DAO objects (uses existing Access "Email" table).
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("Email")

    'Set Up Outlook objects.
    Dim cMail As Outlook.MailItem
    Dim cAtch As Outlook.Attachments


    Set myMail = myFolder.Items
    'MsgBox myMail.Count '7345

    Set objProp = myMail

    iNumMessages = objProp.Count
    If iNumMessages <> 0 Then
        For i = 5 To iNumMessages
            If TypeName(objProp(i)) = "MailItem" Then
                Set cMail = objProp(i)
                Debug.Print cMail.SentOn
                If (CDate(cMail.SentOn) > CDate("2017-06-29") And CDate(cMail.SentOn) < CDate("2018-08-22")) Then
                    rst.AddNew
                    rst!SenderName = cMail.SenderName
                    rst!Sender = cMail.SenderEmailAddress
                    rst!SentOn = cMail.SentOn
                    rst!To = cMail.To
                    rst!CC = cMail.CC
                    rst!Subject = cMail.Subject
                    rst.Update
                End If
            End If
        Next i
    End If



End Sub

当我调试'i'时，它似乎只包含351个项目

Answer 1

您的代码中没有明显的错误。因此，您已经知道如何遍历文件夹。

在删除对Access和其他变量的引用后，您应该发现此代码本质上是相同的，但是更简单。尝试确定问题是否是由于GiftCard邮箱Access引起的。

Sub log_folder_SimplerExample()

    Dim myNamespace As Namespace
    Dim myFolder As Folder

    Dim myMail As Items
    Dim cMail As mailItem

    Dim iNumMessages As Long
    Dim i As Long

    Set myNamespace = GetNamespace("MAPI")
    'put your folders name here
    'Set myFolder = myNamespace.Folders("GiftCard").Folders("Inbox")
    'Set myFolder = myNamespace.Folders("GiftCard").Folders("Sent Items")
    'Set myFolder = myNamespace.Folders("GiftCard").Folders("Deleted Items")

    ' Check other folders for comparison
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
    'Set myFolder = myNamespace.GetDefaultFolder(olFolderSentMail)
    'Set myFolder = myNamespace.GetDefaultFolder(olFolderDeletedItems)

    Set myMail = myFolder.Items

    MsgBox myMail.count

    ' Use myMail.count since the result is the expected
    ' Drop possibly extraneous variables

    iNumMessages = myMail.count

    If iNumMessages > 4 Then

        For i = 5 To iNumMessages

            If TypeName(myMail(i)) = "MailItem" Then

                Set cMail = myMail(i)

                Debug.Print i & " - " & myMail(i).SentOn

                If (CDate(cMail.SentOn) > CDate("2017-06-29") And CDate(cMail.SentOn) < CDate("2018-08-22")) Then
                    Debug.Print "   " & cMail.senderName & vbCr
                End If

            End If

        Next i

    End If

    Debug.Print "Done."

End Sub

Loop认为我的Outlook收件箱使用vba

1 个答案: