VBA循环访问所有收件箱，包括共享收件箱
VBA循环访问所有收件箱，包括共享收件箱
提问于 2018-08-09 23:07:40
我有在用户的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回答 2
Stack Overflow用户
回答已采纳
发布于 2018-08-10 22:33:47
您可以像这样引用任何收件箱：
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 SubStack Overflow用户
发布于 2018-08-10 02:54:29
我真的没有能力测试这是否有效，但这些是我在评论中提到的变化，我希望它们能起作用！
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/51770455
复制相关文章
相似问题
腾讯云开发者
