搜索特定的Outlook文件夹

Question

我一直在搜寻互联网，以寻找一种使用Activecell固定器来搜索Outlook特定文件夹（而不是收件箱！）的宏的简便方法。 我已经尝试过Excel VBA在Outlook邮件中搜索和Outlook中的 VBA搜索都无济于事。 首先，我在使用Outlook引用时遇到了问题，现已解决。 我能得到的最接近的是使用以下代码：

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim myitem As Object
Dim Found As Boolean
Dim OutlookSearch as string

Outlooksearch = Cstr(Activecell.cells(1,4).Value)

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myitems = myInbox.Items
Found = False

For Each myitem In myitems
    If myitem.Class = olMail Then
        If InStr(1, myitem.Subject, "sketch") > 0 Then
            Debug.Print "Found"
            Found = True
        End If
    End If
Next myitem

'If the subject isn't found:
If Not Found Then
    MsgBox "Cannot find"
End If

myOlApp.Quit
Set myOlApp = Nothing

所以现在，我想做的是使用Activecell.cells（1，4）中的字符串。 作为主题的参数，并在收件箱中的特定Outlook文件夹中进行搜索，以缩小搜索范围。 我所能获得的就是MsgBox，即使我已经发送了一封包含与activecell匹配值的电子邮件。

Answer 1

您可以使用.Folders属性在收件箱中指定要搜索的文件夹。

Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("myFolder")

Answer 2

我玩了一会儿，拿出下面的代码。 无需设置对Outlook的引用。

Sub Test1()

    Dim oOutlook As Object 'Outlook.Application
    Dim nNameSpace As Object 'Outlook.Namespace
    Dim mFolderSelected As Object 'Outlook.MAPIFolder
    Dim cFolder As Object
    Dim oItem As Object
    Dim oMyItem As Object
    Dim sOutlookSearch As String
    Dim aFolders() As String
    Dim i As Long

    'sOutlookSearch needs to be something like:
    '"Mailbox - Darren Bartrup-Cook\Inbox"

    sOutlookSearch = ThisWorkbook.Worksheets("Sheet1").Cells(1, 4)
    sOutlookSearch = Replace(sOutlookSearch, "/", "\")
    aFolders() = Split(sOutlookSearch, "\")

    Set oOutlook = GetObject(, "Outlook.Application")
    Set nNameSpace = oOutlook.GetNamespace("MAPI")

    Set mFolderSelected = nNameSpace.Folders.Item(aFolders(0))
    If Not mFolderSelected Is Nothing Then
        For i = 1 To UBound(aFolders)
            Set cFolder = mFolderSelected.Folders
            Set mFolderSelected = Nothing
            Set mFolderSelected = cFolder.Item(aFolders(i))
            If mFolderSelected Is Nothing Then
              Exit For
            End If
        Next i
    End If

    'Set mFolderSelected = nNameSpace.PickFolder 'Alternative to above code block - just pick the folder.

    For Each oItem In mFolderSelected.items
        If oItem.class = 43 Then '43 = olmail
            If InStr(1, oItem.Subject, "sketch") > 0 Then
                Debug.Print "Found:  " & oItem.sendername
                Exit For
            End If
        End If
    Next oItem

End Sub

查找正确文件夹的代码块来自此处： http : //www.outlookcode.com/d/code/getfolder.htm