我使用此代码的目标是根据主题(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" 跳过到底部结束如果。我想如果在
"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
最佳答案
如果您 Set allStores = Nothing在 j 循环内，它只会在第一次迭代中出现。
Option Explicit
' Think of Option Explicit as being mandatory
' Tools | Options
' Editor tab
' Checkbox "Require Variable Declaration"
' Option Explict will generate automatically on new modules
' You may type it in at the top of an existing module
' This as well points out possible spelling errors in the variables
Sub Display()
'In Excel set reference to Outlook Object Library
Dim Fldr As Outlook.Folder
Dim olMail As Outlook.MailItem
Dim olItem As Object
Dim olReply As Outlook.MailItem
Dim olItems As Outlook.Items
Dim signature As String
Dim i As Long
Dim j As Long
Dim allStores As Stores
Dim storeInbox As Folder
signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(signature, vbDirectory) <> vbNullString Then
signature = signature & Dir$(signature & "*.htm")
signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll
Else
signature = ""
End If
' Usually works with Outlook open.
' If this proves to be unreliable,
' you may need a CreateObject("Outlook.Application")
Set allStores = Session.Stores
For j = 1 To allStores.Count
' No need to bypass wrong index error here
' The error has been fixed by using j not i
Debug.Print j & " DisplayName - " & allStores(j).DisplayName
' Reset storeInbox to nothing or it will remain the previous
' when there is an error on the current store
' This is one example of why to be careful with On Error Resume Next
Set storeInbox = Nothing
On Error Resume Next
' bypass error if store does not have an inbox
Set storeInbox = allStores(j).GetDefaultFolder(olFolderInbox)
On Error GoTo 0
If Not storeInbox Is Nothing Then
Set Fldr = storeInbox
Set olItems = Fldr.Items
' Not needed?
'olItems.Sort "[Received]", True
For i = 1 To olItems.Count
Set olItem = olItems(i)
If TypeOf olItem Is Outlook.MailItem Then
Set olMail = olItem
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
' Generates a compile error. Appears not needed.
'.Subject
End With
olMail.Categories = "Executed"
olMail.Display 'olMail.Save
End If
End If
End If
Next
End If
Next j
ExitRoutine:
Set allStores = Nothing
Set storeInbox = Nothing
End Sub
关于excel - 让 VBA 循环遍历 Outlook 中的所有收件箱，包括共享收件箱，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/51931367/