【发布时间】：2019-01-26 14:53:00
【问题描述】：
我使用此代码的目标是根据主题（B8）回复用户前景中的特定电子邮件。基本上让代码循环遍历所有用户的收件箱，包括共享收件箱以查找电子邮件。
我拥有的第一个代码将进入用户的 Outlook，但只进入他们的主收件箱并拉出电子邮件进行回复。这可以正常工作。
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 Long
Dim signature As String
Dim olitem As Object
Set Fldr = Session.GetDefaultFolder(olFolderInbox)
Set olitems = Fldr.Items
olitems.Sort "[Received]", True
For i = 1 To olitems.Count
Set olitem = olitems(i)
If Not TypeOf olitem Is Outlook.MailItem Then GoTo SkipToNext
Set olMail = olitem
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," & "Regards," & "</p><br>" & signature & .HTMLBody
.Display
.Subject
End With
Exit For
olMail.Categories = "Executed"
Exit For
End If
End If
SkipToNext:
Next i
End Sub
这第二部分代码是我的反复试验以及对其他资源的使用尝试让代码循环通过用户的所有收件箱。问题是它不再做任何事情了。
我确实有这个场景的工作代码，然后我错误地保存了它，我没有成功让它恢复工作。下面是我所能得到的最接近的。
任何建议将不胜感激。
第二个脚本似乎从"Set olitems = Fldr.Items" 跳到底部的End If。
如果在"If not storeinbox Is Nothing Then" 正下方，我想可能会移动End，但会出现错误"Object variable or With block variable not set"。
当我更改代码行时（同时进行上述更改）"Set Fldr = Storeinbox" to "Set Fldr = Session.GetDefaultFolder(olFolderInbox)" 电子邮件将填充，但仅在用户的特定收件箱中（不接收主题文本，仅接收最近的电子邮件）。
我在第二个脚本中添加了额外的代码
Set olitem = olitems(i)
If Not TypeOf olitem Is Outlook.MailItem Then GoTo SkipToNext
Set olMail = olitem
缺少的。这将按主题填充用户特定电子邮件地址的电子邮件。如果我从另一个收件箱输入一个主题，那么什么都不会发生，但它会通过代码而没有错误。
越来越近，但共享收件箱仍然没有。
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
Dim allStores As Stores
Dim storeInbox As Folder
Dim j As Long
Set allStores = Session.Stores
For j = 1 To allStores.Count
On Error Resume Next
Debug.Print j & " DisplayName - " & allStores(j).DisplayName
On Error GoTo 0
Set storeInbox = Nothing
On Error Resume Next
Set storeInbox = allStores(j).GetDefaultFolder(olFolderInbox)
On Error GoTo 0
If Not storeInbox Is Nothing Then
Set Fldr = storeinbox
Set olItems = Fldr.Items
olItems.Sort "[Received]", True
For i = 1 To olItems.Count
Set olitem = olitems(i)
If Not TypeOf olitem Is Outlook.MailItem Then GoTo SkipToNext
Set olMail = olitem
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," &
"Regards," & "</p><br>" & signature & .HTMLBody
.Display
.Subject
End With
Exit For
olMail.Categories = "Executed"
End If
End If
Next
End If
ExitRoutine:
Set allStores = Nothing
Set storeInbox = Nothing
SkipToNext:
Next j
End Sub
【问题讨论】：
-
更改 j 循环以使用 j 索引而不是 I 索引，如此处所示 stackoverflow.com/a/51788772/1571407
-
@niton 抱歉，我没有更新问题中的那部分代码。我确实更改了 j 循环，并且 cmets 关于它如何不起作用的是“缺少哪个。这将填充用户的电子邮件......”位于上方。