VBA遍历包括共享收件箱在内的所有收件箱 [英] VBA to loop through all inboxes including shared inboxes

问题描述

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

I have working code that replies to an email in the user's Outlook, based on the subject. However I am not able to have the code search through all the user's inboxes.

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

As of now it will only search through the user's specific inbox. Here is my code, I have searched around but I can not find a solution that my knowledge of VBA can comprehend.

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

推荐答案

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

You may reference any Inbox like this:

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

这篇关于VBA遍历包括共享收件箱在内的所有收件箱的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！