使用Excel VBA從Outlook文件夾中提取電子郵件數據

使用Excel基於變量（Excel中的值/命名範圍）進入Outlook中指定文件夾的宏，並從指定文件夾中的電子郵件中提取數據（To ：字段，主題，..等）。使用Excel VBA從Outlook文件夾中提取電子郵件數據

除了電子郵件的「主題」和「大小」數據之外，除了無法提取任何內容的部分外，代碼的工作原理都很好。例如，如果我嘗試使用與「主題」或「大小」編碼相同的方法提取「To」數據，則會出現「運行時錯誤'438'：對象不支持此屬性。或方法錯誤

下面就是我這麼遠;

Sub FetchEmailData() 

Dim appOutlook As Object 
Dim olNs As Object 
Dim olFolder As Object 
Dim olItem As Object 
Dim iRow As Integer 

'Get/create Outlook Application 
On Error Resume Next 
Set appOutlook = GetObject(, "Outlook.Application") 
If appOutlook Is Nothing Then 
    Set appOutlook = CreateObject("Outlook.Application") 
End If 
On Error GoTo 0 

Set olNs = appOutlook.GetNamespace("MAPI") 
Set olFolder = olNs.Folders("Mailbox_name").Folders("Inbox").Folders("XYZ").Folders("2017").Folders("04. April").Folders("Etc") 

'Clear 
ThisWorkbook.Sheets("Test").Cells.Delete 

'Build headings: 
ThisWorkbook.Sheets("Test").Range("A1:D1") = Array("Sender_Email_Address", "Subject", "To", "Size") 

For iRow = 1 To olFolder.Items.Count 
    ThisWorkbook.Sheets("Test").Cells(iRow, 1).Select 
    'ThisWorkbook.Sheets("Test").Cells(iRow, 1) = olFolder.Items.Item(iRow).SenderEmailAddress 
    ThisWorkbook.Sheets("Test").Cells(iRow, 2) = olFolder.Items.Item(iRow).Subject 
    'ThisWorkbook.Sheets("Test").Cells(iRow, 3) = olFolder.Items.Item(iRow).To 
    ThisWorkbook.Sheets("Test").Cells(iRow, 4) = olFolder.Items.Item(iRow).Size 
Next iRow 

End Sub

任何幫助將不勝感激，或者如果任何人都可以在正確的方向指向我修改代碼，以便能夠提取其他電子郵件字段，如From和To字段。

另外，如果我的Set olFolder值是在ex中的命名範圍cel會隨着日期而動態變化（=Today()），並使用Folder_Location作爲Excel中的命名範圍，是否可以正確寫入;

Set olFolder = ThisWorkbook.Sheets("Setup").Range("Folder_Location")

凡

Folder_Location = olNs.Folders("Mailbox_name").Folders("Inbox").Folders("XYZ").Folders("2017").Folders("04. April").Folders("Etc")

在Excel - >這使示數上我，當我試圖再次將其olFolder

，謝謝

來源

2017-04-27 FV92

我知道這是一個老問題，但最近我遇到了同樣的問題，並且在完成已經完成的工作後能夠弄清楚。

我只需要做一些改變;首先，我把我的選擇的文件夾，給我的純樸的緣故收件箱：

Set olFolder = olNs.GetDefaultFolder(6) ' 6 == Inbox for some reason

然後，我改變了你做只是有點爲我的可讀性標題（不是功能性改變）：

ThisWorkbook.Sheets("Data").Range("A1:D1") = Array("Sender Email Address:", "Subject:", "To:", "Size:")

最後讓你要找的功能，一個小的變化需要你indicies來進行你的「單元格格式」參數中的for循環：

For iRow = 1 To olFolder.Items.Count 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 1) = olFolder.Items.Item(iRow).SenderEmailAddress 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 2) = olFolder.Items.Item(iRow).Subject 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 3) = olFolder.Items.Item(iRow).To 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 4) = olFolder.Items.Item(iRow).Size

下一頁iRow

那裏的「+1」使得它不會覆蓋我們的標題。所以最終版本看起來像這樣：

Sub FetchEmailData() 

Dim appOutlook As Object 
Dim olNs As Object 
Dim olFolder As Object 
Dim olItem As Object 
Dim iRow As Integer 

' Get/create Outlook Application 
On Error Resume Next 
Set appOutlook = GetObject(, "Outlook.Application") 
If appOutlook Is Nothing Then 
    Set appOutlook = CreateObject("Outlook.Application") 
End If 
On Error GoTo 0 

Set olNs = appOutlook.GetNamespace("MAPI") 
Set olFolder = olNs.GetDefaultFolder(6) ' 6 == Inbox for some reason 

' Clear 
ThisWorkbook.Sheets("Test").Cells.Delete 

' Build headings: 
ThisWorkbook.Sheets("Test").Range("A1:D1") = Array("Sender Email Address:", "Subject:", "To:", "Size:") 

For iRow = 1 To olFolder.Items.Count 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 1) = olFolder.Items.Item(iRow).SenderEmailAddress 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 2) = olFolder.Items.Item(iRow).Subject 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 3) = olFolder.Items.Item(iRow).To 
    ThisWorkbook.Sheets("Test").Cells(iRow + 1, 4) = olFolder.Items.Item(iRow).Size 
Next iRow 

End Sub

來源

2017-08-02 13:52:13

使用Excel VBA從Outlook文件夾中提取電子郵件數據

回答

相關問題