Question

我想从名为“FaxReceipt”的Outlook文件夹中的电子邮件中提取文本到Excel电子表格

我创建了一个名称“FaxReceipt”。我希望将所有文本提取到Excel列中。

Sub OutlookEMails1()
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As Object
Dim mai As MailItem

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
i = 0
If Inbox.Items.Count = 0 Then
    MsgBox "Inbox is Empty", vbInformation, "Nothing Found"
End If

For Each item In Inbox.Items
    vbody = item.Body
    Range("A2").Select

    Do Until ActiveCell.Value = ""
        ActiveCell.Offset(1).Select
    Loop
    ActiveCell.Value = vbody
Next

Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing

End Sub

此代码仅适用于默认的收件箱文件夹。

Answer 1

您只需将代码更改为：

一个。将对象设置为收件箱的子文件夹（您已经有了 objSearchFolder - 你刚才没有使用它。）

B中。查看该对象而不是收件箱

"a, t 11, 2017"

Answer 2

试试这个：

Sub OutlookEMails1()

Dim ns                  As Namespace
Dim Inbox               As MAPIFolder
Dim myitem              As Outlook.MailItem
Dim FileName            As String
Dim i                   As Integer
Dim objSearchFolder     As Outlook.MAPIFolder
Dim item                As Object
Dim mai                 As MailItem
Dim objFaxReceiptFolder As Object

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
Set objFaxReceiptFolder = Inbox.Folders("faxreceipt")
i = 0
If objFaxReceiptFolder.Items.Count = 0 Then
    MsgBox "Folder Fax Receipt is Empty", vbInformation, "Nothing Found"
End If
For Each item In objFaxReceiptFolder.Items
    vbody = item.Body
Range("A2").Select

Do Until ActiveCell.Value = ""
    ActiveCell.Offset(1).Select
Loop
    ActiveCell.Value = vbody
Next
Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing

End Sub

引用收件箱的子文件夹

2 个答案: