如何引用搜索文件夹?
How to reference a search folder?
我们在 Excel 中使用 VBA 宏来计算多个 Outlook 子文件夹中的邮件数量。
我也想用它来计算搜索文件夹中的邮件数量,但它不起作用。
代码循环遍历不同的 Outlook 文件夹,每个文件夹的位置在 Excel sheet 的列中可用。 (mailbox@mail.com\folder\subfolder - 具有不同的邮箱/文件夹可能性)。
我们用下面的代码引用这个文件夹:
set mailfolder = GetFolder(email_folder)
这是 GetFolder 函数:
Function GetFolder(ByVal strFolderPath As String) As MAPIFolder
' strFolderPath needs to be something like
' "Public Folders\All Public Folders\Company\Sales" or
' "Personal Folders\Inbox\My Folder"
Dim objApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long
On Error Resume Next
'strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
On Error GoTo 0
End Function
有没有办法调整此功能以查找搜索文件夹?
使用文件夹名称。没有路径。
Private Sub Test_Unread()
FindSearchFolder "Unread Mail"
End Sub
Private Sub FindSearchFolder(fldrName As String)
Debug.Print
Debug.Print "Searching for " & fldrName
Dim objStores As Stores
Dim objStore As Store
Dim objSearchFolders As folders
Dim objSearchFolder As folder
Dim objItem As Object
Dim bFound As Boolean
Dim i As Long
Set objStores = Session.Stores
For Each objStore In objStores
Debug.Print
Debug.Print "objStore: " & objStore
bFound = False
Set objSearchFolders = objStore.GetSearchFolders
For Each objSearchFolder In objSearchFolders
Debug.Print " objSearchFolder: " & objSearchFolder
If objSearchFolder.name = fldrName Then
Debug.Print " Found in " & objStore
bFound = True
Set ActiveExplorer.CurrentFolder = objSearchFolder
Debug.Print objSearchFolder.Items.count
End If
If bFound = True Then Exit For
Next
If bFound = False Then Debug.Print " Not found in " & objStore
Next
End Sub
如果您发现 unfixable/unexplainable 的错误,当 testing/manipulating 搜索文件夹时,关闭 Outlook 并重新启动。
我们在 Excel 中使用 VBA 宏来计算多个 Outlook 子文件夹中的邮件数量。 我也想用它来计算搜索文件夹中的邮件数量,但它不起作用。
代码循环遍历不同的 Outlook 文件夹,每个文件夹的位置在 Excel sheet 的列中可用。 (mailbox@mail.com\folder\subfolder - 具有不同的邮箱/文件夹可能性)。
我们用下面的代码引用这个文件夹:
set mailfolder = GetFolder(email_folder)
这是 GetFolder 函数:
Function GetFolder(ByVal strFolderPath As String) As MAPIFolder
' strFolderPath needs to be something like
' "Public Folders\All Public Folders\Company\Sales" or
' "Personal Folders\Inbox\My Folder"
Dim objApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long
On Error Resume Next
'strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
On Error GoTo 0
End Function
有没有办法调整此功能以查找搜索文件夹?
使用文件夹名称。没有路径。
Private Sub Test_Unread()
FindSearchFolder "Unread Mail"
End Sub
Private Sub FindSearchFolder(fldrName As String)
Debug.Print
Debug.Print "Searching for " & fldrName
Dim objStores As Stores
Dim objStore As Store
Dim objSearchFolders As folders
Dim objSearchFolder As folder
Dim objItem As Object
Dim bFound As Boolean
Dim i As Long
Set objStores = Session.Stores
For Each objStore In objStores
Debug.Print
Debug.Print "objStore: " & objStore
bFound = False
Set objSearchFolders = objStore.GetSearchFolders
For Each objSearchFolder In objSearchFolders
Debug.Print " objSearchFolder: " & objSearchFolder
If objSearchFolder.name = fldrName Then
Debug.Print " Found in " & objStore
bFound = True
Set ActiveExplorer.CurrentFolder = objSearchFolder
Debug.Print objSearchFolder.Items.count
End If
If bFound = True Then Exit For
Next
If bFound = False Then Debug.Print " Not found in " & objStore
Next
End Sub
如果您发现 unfixable/unexplainable 的错误,当 testing/manipulating 搜索文件夹时,关闭 Outlook 并重新启动。