vba - 将收件箱 + 子文件夹中的所有 email.Items 相加
问题描述
下午好,
我正在通过 Table 对象填充来自收件箱 + 子文件夹的所有电子邮件的列表框。这工作正常。
然后,通过Doubleclick
来自 的事件ListBox1
,我试图打开被选中的电子邮件。如果循环仅通过收件箱文件夹,则它是正确的。但是当我试图从收件箱中循环子文件夹时,它不会去。所以我试图将收件箱+子文件夹中的所有电子邮件收集(总和)在一个:
Set InboxItems = SubFolder.Items
但是offcorse它不起作用。可以做什么?
我的代码:
Option Explicit
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim objNS As Outlook.namespace: Set objNS = GetNamespace("MAPI")
Dim oFolder As Outlook.MAPIFolder: Set oFolder = objNS.GetDefaultFolder(olFolderInbox)
Dim i As Long
Dim j As Long
Dim InboxItems As Outlook.Items
Dim thisEmail As Outlook.MailItem
Dim SubFolder As Outlook.MAPIFolder
Dim myArray() As String
Dim Folders As New Collection
Dim entryID As New Collection
Dim StoreID As New Collection
Call GetFolder(Folders, entryID, StoreID, oFolder)
myArray = ConvertToArray(indexEmailInbox)
For j = 1 To Folders.Count
Set SubFolder = Application.Session.GetFolderFromID(entryID(j), StoreID(j))
Set InboxItems = SubFolder.Items
Next
For i = LBound(myArray) To UBound(myArray)
If Me.ListBox1.Selected(i) = True Then
If TypeName(InboxItems.Item(onlyDigits(myArray(i)))) = "MailItem" Then ' it's an email
'MsgBox onlyDigits(myArray(UBound(myArray) - i - 1))
Set thisEmail = InboxItems.Item(onlyDigits(myArray(UBound(myArray) - i - 1)))
Unload Me
thisEmail.Display
Exit Sub
End If
End If
Next i
End Sub
Function ConvertToArray(ByVal value As String)
value = StrConv(value, vbUnicode)
ConvertToArray = Split(Left(value, Len(value) - 1), "§")
End Function
Sub GetFolder(folders As Collection, entryID As Collection, StoreID As Collection, fld As MAPIFolder)
Dim SubFolder As MAPIFolder
folders.Add fld.FolderPath
entryID.Add fld.entryID
StoreID.Add fld.StoreID
For Each SubFolder In fld.folders
GetFolder folders, entryID, StoreID, SubFolder
Next SubFolder
ExitSub:
Set SubFolder = Nothing
End Sub
解决方案
You may .Add
items to a collection one at a time.
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Private Sub collection_Emails_Folder_And_Subfolders()
Dim objFolder As folder
Dim myItemsCol As New Collection
Dim i As Long
Dim myItems As Items
Set objFolder = Session.PickFolder
If objFolder Is Nothing Then
Exit Sub
End If
'Set objFolder = Session.GetDefaultFolder(olFolderInbox)
processFolder objFolder, myItemsCol
' Methods available are limited to:
' Add, Count, Item and Remove
Debug.Print vbCr & "Final total - myItemsCol.Count: " & myItemsCol.Count
' You may access item properties
For i = 1 To myItemsCol.Count
Debug.Print " " & i & ": " & myItemsCol(i).ReceivedTime, myItemsCol(i).subject
Next i
End Sub
Private Sub processFolder(ByVal objFolder As folder, ByVal myItemsCol As Collection)
' https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders
Dim EmailCount As Long
Dim myItem As Object
Dim myItems As Items
Dim i As Long
Dim oFolder As folder
Debug.Print vbCr & "objFolder: " & objFolder
EmailCount = objFolder.Items.Count
Debug.Print " EmailCount...: " & EmailCount
If EmailCount > 0 Then
Set myItems = objFolder.Items
myItems.Sort "[ReceivedTime]", False ' oldest to newest
For i = 1 To myItems.Count
'Debug.Print " " & i & ": " & myItems(i).ReceivedTime, myItems(i).subject
myItemsCol.Add myItems(i)
Next
End If
Debug.Print " Running total: " & myItemsCol.Count
If (objFolder.Folders.Count > 0) Then
For Each oFolder In objFolder.Folders
processFolder oFolder, myItemsCol
Next
End If
End Sub
You should be able to replace InboxItems
with myItemsCol
.
If TypeName(myItemsCol.Item((onlyDigits(myArray(i)))) = "MailItem" Then ' it's an email
Set thisEmail = myItemsCol.Item(onlyDigits(myArray(UBound(myArray) - i - 1)))
推荐阅读
- face-recognition - dlib 如何从对齐的面上获取 128D 向量?有参考文献吗?
- javascript - 角电子mysql创建连接不是一个函数
- camera - DLT 与单应性估计
- python - class.property 上的点符号解释
- angular - TypeError: this.http.post(...).map 在将 angular 5 更新为 angular 6 后不是函数
- angular-cli - Angular 6 使用资产构建库
- python - 如何将 LaTeX 文档中的变量提取到 Python 字典中,以便将其拉入 Django?
- javascript - 过滤具有多个属性的多个数组对象
- c# - 我可以阻止 PropertyInfo.SetValue 删除前导换行符吗?
- python - How to convert from a decimal to hex in python without using hex()?