Question

我有可以根据主题在用户Outlook中回复电子邮件的工作代码。但是，我无法在所有用户的收件箱中进行代码搜索。

到目前为止，它将仅在用户的特定收件箱中进行搜索。这是我的代码，我已经搜索了一下，但是找不到我对VBA的了解可以理解的解决方案。

Sub Display()

    Dim Fldr As Outlook.Folder
    Dim olfolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim olReply As Outlook.MailItem
    Dim olItems As Outlook.Items
    Dim i As Integer
    Dim signature As String

    Set Fldr = Session.GetDefaultFolder(olFolderInbox)
    Set olItems = Fldr.Items

    olItems.Sort "[Received]", True

    For i = 1 To olItems.count
        signature = Environ("appdata") & "\Microsoft\Signatures\"

        If Dir(signature, vbDirectory) <> vbNullString Then
            signature = signature & Dir$(signature & "*.htm")
        Else
            signature = ""
        End If

        signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll

        Set olMail = olItems(i)

        If InStr(olMail.Subject, Worksheets("Checklist Form").Range("B8")) <> 0 Then
            If Not olMail.Categories = "Executed" Then
                Set olReply = olMail.ReplyAll

                With olReply
                    .HTMLBody = "<p style='font-family:calibri;font-size:14.5'>" & "Hi Everyone," & _
                        "<p style='font-family:calibri;font-size:14.5'>" & "Workflow ID:" & " " & _
                        Worksheets("Checklist Form").Range("B6") & "<p style='font-family:calibri;font-size:14.5'>" & _
                        Worksheets("Checklist Form").Range("B11") & "<p style='font-family:calibri;font-size:14.5'>" & _
                        "Regards," & "</p><br>" & signature & .HTMLBody
                    .Display
                    .Subject = "RO Finalized WF:" & Worksheets("Checklist Form").Range("B6") & " " & _
                        Worksheets("Checklist Form").Range("B2") & " -" & Worksheets("Fulfillment Checklist").Range("B3")
                End With

                Exit For
                olMail.Categories = "Executed"

            End If
        End If

    Next i

End Sub

Answer 1

您可以这样引用任何收件箱：

Option Explicit

Sub Inbox_by_Store()

Dim allStores As Stores
Dim storeInbox As Folder

Dim j As Long

Set allStores = Session.Stores

For j = 1 To allStores.count

    Debug.Print j & " DisplayName - " & allStores(j).DisplayName

    Set storeInbox = Nothing

    ' Some stores will not have an inbox
    ' Bypass possible expected error if there is no inbox in the store
    On Error Resume Next
    ' Note this is one of the rare acceptable uses for On Error Resume Next
    Set storeInbox = allStores(j).GetDefaultFolder(olFolderInbox)
    ' Turn off error bypass as soon as it is no longer needed
    On Error GoTo 0

    If Not storeInbox Is Nothing Then
        storeInbox.Display

        ' your code here instead of storeInbox.Display
        ' Set Fldr = storeInbox

    End If

Next

ExitRoutine:
    Set allStores = Nothing
    Set storeInbox = Nothing

End Sub

Answer 2

我真的没有能力测试它是否有效，但是这些是我在评论中提到的更改，希望它们有效！

Sub Display()

    '...

    Set Fldr = Session.GetDefaultFolder(olFolderInbox)

    Dim mySubfolder As Outlook.Folder       'added
    For Each mySubfolder In Fldr.Folders    'added

        Set olItems = mySubfolder.Items     'changed

        For i = 1 To olItems.count

        '...

        Next i

    Next mySubfolder                        'added

End Sub

VBA遍历包括共享收件箱在内的所有收件箱

2 个答案: