VBA在Outlook中搜索一封电子邮件并在excel中检索详细信息

Question

我想根据邮件主题或部分邮件主题检索邮箱（主要是收件箱）中的电子邮件列表。我有下面的代码。但这不起作用。

Sub Work_with_Outlook()

 Set olApp = CreateObject("Outlook.Application")

    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Variant
    Dim sir() As String

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items

  Set olMail = myTasks.Find("[Subject] = ""RE: Disconnect the DB with Live DB""")
  If Not (olMail Is Nothing) Then
  sir = Split(olMail.Body, vbCrLf)
  For i = 1 To UBound(sir)
  ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value = sir(i)
  Next i
  olMail.Delete
  End If

End Sub

我还有另一个代码可以列出收件箱中的所有邮件。但是我又需要从那里搜索关键字。因此，如果我只能搜索主题行或主题行的一部分，将会更容易。其他代码如下。

Option Explicit

Private Sub CommandButton1_Click()
    On Error GoTo ErrHandler

    ' SET Outlook APPLICATION OBJECT.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")

    ' CREATE AND SET A NameSpace OBJECT.
    Dim objNSpace As Object
    ' THE GetNameSpace() METHOD WILL REPRESENT A SPECIFIED NAMESPACE.
    Set objNSpace = objOutlook.GetNamespace("MAPI")

    ' CREATE A FOLDER OBJECT.
    Dim myFolder As Object
    Set myFolder = objNSpace.GetDefaultFolder(olFolderInbox)

    Dim Item As Object
    Dim iRows, iCols As Integer
    iRows = 2

    ' LOOP THROUGH EACH ITEMS IN THE FOLDER.
    For Each objItem In myFolder.Items
        If objItem.Class = olMail Then

            Dim objMail As Outlook.MailItem
            Set objMail = objItem

            Cells(iRows, 1) = objMail.SenderEmailAddress
            Cells(iRows, 2) = objMail.To
            Cells(iRows, 3) = objMail.Subject
            Cells(iRows, 4) = objMail.ReceivedTime
        End If

        ' SHOW OTHER PROPERTIES, IF YOU WISH.
        'Cells(iRows, 6) = objMail.Body
        'Cells(iRows, 5) = objMail.CC
        'Cells(iRows, 6) = objMail.BCC
        'Cells(iRows, 4) = objMail.Recipients(1)

        iRows = iRows + 1
    Next
    Set objMail = Nothing

    ' RELEASE.
    Set objOutlook = Nothing
    Set objNSpace = Nothing
    Set myFolder = Nothing
ErrHandler:
    Debug.Print Err.Description
End Sub

谢谢，弥勒