Question

我一直在搜索互联网，以便使用activecell holder轻松搜索Outlook特定文件夹（而不是收件箱！）。我试过Excel VBA for searching in mails of Outlook和VBA Search in Outlook无济于事。首先，我遇到了使用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文件夹中进行搜索，以使其更窄。即使我发送了一封包含与activecell匹配值的电子邮件，我所能得到的只是MsgBox。

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

搜索特定Outlook文件夹

2 个答案: