Note: The other languages of the website are Google-translated. Back to English

如何將電子郵件從多個文件夾/子文件夾導出到Outlook中的Excel?

使用Outlook中的“導入和導出”嚮導導出文件夾時,它不支持 包括子文件夾 如果將文件夾導出到CSV文件,則為選項。 但是,將每個文件夾導出到CSV文件然後手動將其轉換為Excel工作簿將非常耗時且乏味。 在這裡,本文將介紹一個VBA,可以輕鬆地將多個文件夾和子文件夾快速導出到Excel工作簿。

使用VBA將多個文件夾中的多個電子郵件導出到Excel

Office選項卡-在Office中啟用選項卡式編輯和瀏覽,並使工作更加容易...
Kutools for Outlook-為Microsoft Outlook帶來100種強大的高級功能
  • 自動CC / BCC 根據規則發送電子郵件; 自動前進 按規則發送多封電子郵件; 自動回复 沒有交換服務器,還有更多自動功能...
  • BCC警告 -如果您的郵件地址在密件抄送列表中,則當您嘗試全部答复時顯示消息; 缺少附件時提醒,還有更多提醒功能...
  • 回复(全部)帶有所有附件 在郵件對話中; 一次回复許多電子郵件; 自動添加問候語 回复時自動將日期和時間添加到主題中...
  • 附件工具:自動分離,全部壓縮,重命名,自動保存所有... 快速報告,計算所選郵件, 刪除重複的郵件和聯繫人...
  • 超過 100 項高級功能將 解決您的大部分問題 在 Outlook 2021 - 2010 或 Office 365 中。完整功能 60 天免費試用。

箭頭藍色右氣泡 使用VBA將多個文件夾中的多個電子郵件導出到Excel

請按照以下步驟使用Outlook中的VBA將電子郵件從多個文件夾或子文件夾導出到Excel工作簿。

1。 按 其他 + F11 鍵以打開“ Microsoft Visual Basic應用程序”窗口。

2。 點擊 插入 > 模塊,然後將以下VBA代碼粘貼到新的“模塊”窗口中。

VBA:將電子郵件從多個文件夾和子文件夾導出到Excel

Const MACRO_NAME = "Export Outlook Folders to Excel"

Sub ExportMain()
ExportToExcel "destination_folder_path\A.xlsx", "your_email_accouny\folder\subfolder_1"
ExportToExcel "destination_folder_path\B.xlsx", "your_email_accouny\folder\subfolder_2"
MsgBox "Process complete.", vbInformation + vbOKOnly, MACRO_NAME
End Sub
Sub ExportToExcel(strFilename As String, strFolderPath As String)
Dim      olkMsg As Object
Dim olkFld As Object
Dim excApp As Object
Dim excWkb As Object
Dim excWks As Object
Dim intRow As Integer
Dim intVersion As Integer

If strFilename <> "" Then
If strFolderPath <> "" Then
Set olkFld = OpenOutlookFolder(strFolderPath)
If TypeName(olkFld) <> "Nothing" Then
intVersion = GetOutlookVersion()
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add()
Set excWks = excWkb.ActiveSheet
'Write Excel Column Headers
With excWks
.Cells(1, 1) = "Subject"
.Cells(1, 2) = "Received"
.Cells(1, 3) = "Sender"
End With
intRow = 2
For Each olkMsg In olkFld.Items
'Only export messages, not receipts or appointment requests, etc.
If olkMsg.Class = olMail Then
'Add a row for each field in the message you want to export
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion)
intRow = intRow + 1
End If
Next
Set olkMsg = Nothing
excWkb.SaveAs strFilename
excWkb.Close
Else
MsgBox "The folder '" & strFolderPath & "' does not exist in Outlook.", vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox "The folder path was empty.", vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox "The filename was empty.", vbCritical + vbOKOnly, MACRO_NAME
End If

Set olkMsg = Nothing
Set olkFld = Nothing
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
End Sub

Public Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant
Dim varFolder As Variant
Dim bolBeyondRoot As Boolean

On Error Resume Next
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
Do While Left(strFolderPath, 1) = "\"
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
Loop
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
Select Case bolBeyondRoot
Case False
Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
bolBeyondRoot = True
Case True
Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
End Select
If Err.Number <> 0 Then
Set OpenOutlookFolder = Nothing
Exit For
End If
Next
End If
On Error GoTo 0
End Function

Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
Dim olkSnd As Outlook.AddressEntry
Dim olkEnt As Object

On Error Resume Next
Select Case intOutlookVersion
Case Is < 14
If Item.SenderEmailType = "EX" Then
GetSMTPAddress = SMTPEX(Item)
Else
GetSMTPAddress = Item.SenderEmailAddress
End If
Case Else
Set olkSnd = Item.Sender
If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
Set olkEnt = olkSnd.GetExchangeUser
GetSMTPAddress = olkEnt.PrimarySmtpAddress
Else
GetSMTPAddress = Item.SenderEmailAddress
End If
End Select
On Error GoTo 0
Set olkPrp = Nothing
Set olkSnd = Nothing
Set olkEnt = Nothing
End Function

Function GetOutlookVersion() As Integer
Dim arrVer As Variant
arrVer = Split(Outlook.Version, ".")
GetOutlookVersion = arrVer(0)
End Function

Function SMTPEX(olkMsg As Outlook.MailItem) As String
Dim olkPA As Outlook.propertyAccessor
On Error Resume Next
Set olkPA = olkMsg.propertyAccessor
SMTPEX = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")
On Error GoTo 0
Set olkPA = Nothing
End Function

3.請根據需要調整以上VBA代碼。

(1)更換 目的地_文件夾_路徑 在上面的代碼以及目標文件夾的文件夾路徑中,您將保存導出的工作簿,例如 C:\ Users \ DT168 \ Documents \ TEST.
(2)將上述代碼中的your_email_accouny \ folder \ subfolder_1和your_email_accouny \ folder \ subfolder_2替換為Outlook中子文件夾的文件夾路徑,例如 凱莉@extendoffice.com \ Inbox \ A凱莉@extendoffice.com \ Inbox \ B

4。 按 F5 鍵或單擊 按鈕以運行此VBA。 然後點擊 OK 彈出Outlook文件夾導出到Excel對話框中的按鈕。 看截圖:

現在,來自以上VBA代碼中所有指定子文件夾或文件夾的電子郵件將被導出並保存到Excel工作簿中。


箭頭藍色右氣泡相關文章


Kutools for Outlook-為Outlook帶來100個高級功能,並使工作更加輕鬆!

  • 自動CC / BCC 根據規則發送電子郵件; 自動前進 自定義多封電子郵件; 自動回复 沒有交換服務器,還有更多自動功能...
  • BCC警告 -當您嘗試全部答复時顯示消息 如果您的郵件地址在“密件抄送”列表中; 缺少附件時提醒,還有更多提醒功能...
  • 在郵件對話中回复(全部)帶有所有附件; 回复許多電子郵件 片刻之間; 自動添加問候語 回复時將日期添加到主題中...
  • 附件工具:管理所有郵件中的所有附件, 自動分離, 全部壓縮,重命名全部,保存全部...快速報告, 計算選定的郵件...
  • 強大的垃圾郵件 習俗 刪除重複的郵件和聯繫人... 使您能夠在Outlook中做得更聰明,更快和更好。
拍攝kutools前景kutools選項卡1180x121
拍攝kutools前景kutools加標籤1180x121
 
按評論排序
留言 (10)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
如何讓它自動遞歸到子文件夾中?
網站主持人對此評論進行了最小化
你好,親愛的,非常感謝,但正文沒有導出,我如何導出電子郵件正文,excel文件只有(主題,接收和發件人),如果你能用它更新我將解決一個大問題再次感謝我的生意
網站主持人對此評論進行了最小化
嗨蒙塔澤,
VBA 腳本基於 Outlook 的導出功能運行,該功能在從郵件文件夾批量導出電子郵件時不支持導出郵件內容。 因此,此 VBA 腳本也無法導出消息內容。
網站主持人對此評論進行了最小化
這很好用,但是有沒有辦法不僅為上面的 4 個字段添加信息,還為 Outlook 導出到 PST 提供的所有信息添加信息? 主題正文 發件人:(姓名)發件人:(地址)發件人:(類型)收件人:(名稱)收件人:(地址)收件人:(類型)抄送:(名稱)抄送:(地址)抄送:(類型)密件抄送:(名稱)密件抄送:(地址)密件抄送:(類型)計費信息類別重要性里程敏感度

我嘗試添加“重要性”並且它有效,但如果有人可以提供其他字段的代碼,我將不勝感激。 謝謝你!!
與 excWks
.Cells(1, 1) = "主題"
.Cells(1, 2) = "收到"
.Cells(1, 3) = "發件人"
.Cells(1, 4) = "身體"
.Cells(1, 5) = "重要性"
結束
整數行 = 2
對於 olkFld.Items 中的每個 olkMsg
'只導出消息,不導出收據或約會請求等。
如果 olkMsg.Class = olMail 那麼
'為要導出的消息中的每個字段添加一行
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow,3)= GetSMTPAddress(olkMsg,intVersion)
excWks.Cells(intRow, 4) = olkMsg.Body
excWks.Cells(intRow, 5) = olkMsg.Importance
網站主持人對此評論進行了最小化
您好,請根據您的需要檢查以下代碼:
Const MACRO_NAME = "將 Outlook 文件夾導出到 Excel"

子導出主()

ExportToExcel "destination_folder_path\A.xlsx", "your_email_accouny\folder\subfolder_1"

ExportToExcel "destination_folder_path\B.xlsx", "your_email_accouny\folder\subfolder_2"

MsgBox "進程完成。", vbInformation + vbOKOnly, MACRO_NAME

END SUB

Sub ExportToExcel(strFilename 作為字符串,strFolderPath 作為字符串)

將 olkMsg 變暗為對象

將 olkFld 變暗為對象

將 excApp 調暗為對象

將 excWkb 調暗為對象

將 excWks 調暗為對象

將 intRow 調暗為整數

將 intVersion 調暗為整數

如果 strFilename <> "" 那麼

如果 strFolderPath <> "" 那麼

設置 olkFld = OpenOutlookFolder(strFolderPath)

如果 TypeName(olkFld) <> "Nothing" 那麼

intVersion = GetOutlookVersion()

設置 excApp = CreateObject("Excel.Application")

設置 excWkb = excApp.Workbooks.Add()

設置 excWks = excWkb.ActiveSheet

'寫入 Excel 列標題

與 excWks

.Cells(1, 1) = "主題"

.Cells(1, 2) = "身體"

.Cells(1, 3) = "收到"

.Cells(1, 4) = "發件人:(姓名)"

.Cells(1, 5) = “發件人:(地址)”

.Cells(1, 6) = “發件人:(類型)”

.Cells(1, 7) = “收件人:(姓名)”

.Cells(1, 8) = “收件人:(地址)”

.Cells(1, 9) = “收件人:(類型)”

.Cells(1, 10) = “抄送:(名稱)”

.Cells(1, 11) = “抄送:(地址)”

.Cells(1, 12) = “抄送:(類型)”

.Cells(1, 13) = “密件抄送:(名稱)”

.Cells(1, 14) = “密件抄送:(地址)”

.Cells(1, 15) = "密件抄送:(類型)"

.Cells(1, 16) = "賬單信息"

.Cells(1, 17) = "類別"

.Cells(1, 18) = "重要性"

.Cells(1, 19) = "里程"

.Cells(1, 20) = "靈敏度"

結束

整數行 = 2

對於 olkFld.Items 中的每個 olkMsg

'只導出消息,不導出收據或約會請求等。

如果 olkMsg.Class = olMail 那麼

'為要導出的消息中的每個字段添加一行

excWks.Cells(intRow, 1) = olkMsg.Subject

excWks.Cells(intRow, 2) = olkMsg.Body

excWks.Cells(intRow, 3) = olkMsg.ReceivedTime

excWks.Cells(intRow, 4) = olkMsg.SenderName

excWks.Cells(intRow, 5) = GetAddress(olkMsg.Sender, intVersion)

excWks.Cells(intRow, 6) = olkMsg.Sender.Type

excWks.Cells(intRow, 7) = GetRecipientsName(olkMsg, 1, 1, intVersion)

excWks.Cells(intRow, 8) = GetRecipientsName(olkMsg, 1, 2, intVersion)

excWks.Cells(intRow, 9) = GetRecipientsName(olkMsg, 1, 3, intVersion)

excWks.Cells(intRow, 10) = GetRecipientsName(olkMsg, 2, 1, intVersion)

excWks.Cells(intRow, 11) = GetRecipientsName(olkMsg, 2, 2, intVersion)

excWks.Cells(intRow, 12) = GetRecipientsName(olkMsg, 2, 3, intVersion)

excWks.Cells(intRow, 13) = GetRecipientsName(olkMsg, 3, 1, intVersion)

excWks.Cells(intRow, 14) = GetRecipientsName(olkMsg, 3, 2, intVersion)

excWks.Cells(intRow, 15) = GetRecipientsName(olkMsg, 3, 3, intVersion)

excWks.Cells(intRow, 16) = olkMsg.BillingInformation

excWks.Cells(intRow,17)= olkMsg.Categories

excWks.Cells(intRow, 18) = olkMsg.Importance

excWks.Cells(intRow, 19) = olkMsg.Mileage

excWks.Cells(intRow, 20) = olkMsg.靈敏度

整數行 = 整數行 + 1

如果結束

下一頁

設置 olkMsg = 無

excWkb.SaveAs str文件名

excWkb.關閉

其他

MsgBox "文件夾 '" & strFolderPath & "' 在 Outlook 中不存在。", vbCritical + vbOKOnly, MACRO_NAME

如果結束

其他

MsgBox "文件夾路徑為空。", vbCritical + vbOKOnly, MACRO_NAME

如果結束

其他

MsgBox "文件名是空的。", vbCritical + vbOKOnly, MACRO_NAME

如果結束



設置 olkMsg = 無

設置 olkFld = 無

設置 excWks = 無

設置 excWkb = 無

設置 excApp = 無

END SUB



公共函數 OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder

將 arrFolders 變暗為變體

將 varFolder 調暗為變體

Dim bolBeyondRoot 作為布爾值

在錯誤恢復下一頁

如果 strFolderPath = "" 那麼

設置 OpenOutlookFolder = 無

其他

Do While Left(strFolderPath, 1) = "\"

strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)

循環

arrFolders = 拆分(strFolderPath,“\”)

對於 arrFolders 中的每個 varFolder

選擇案例 bolBeyondRoot

案例錯誤

設置 OpenOutlookFolder = Outlook.Session.Folders(varFolder)

bolBeyondRoot = 真

案例真

設置 OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)

最終選擇

如果 Err.Number <> 0 則

設置 OpenOutlookFolder = 無

退出

如果結束

下一頁

如果結束

在錯誤轉到0

函數結束



函數 GetOutlookVersion() 作為整數

變暗 arrVer 作為變體

arrVer = 拆分(Outlook.Version,“.”)

獲取 Outlook 版本 = arrVer(0)

函數結束



函數 SMTPEX(Entry As AddressEntry) 作為字符串

將 olkPA 調暗為 Outlook.PropertyAccessor

在錯誤恢復下一頁

設置 olkPA = Entry.PropertyAccessor

SMTPEX = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")

在錯誤轉到0

設置 olkPA = 無

函數結束



函數 GetAddress(Entry As AddressEntry, intOutlookVersion As Integer) As String

將 olkEnt 作為對象

在錯誤恢復下一頁

選擇案例 intOutlookVersion

案例 < 14

如果 Entry.Type = "EX" 那麼

GetAddress = SMTPEX(條目)

其他

GetAddress = 條目.地址

如果結束

其他情況

如果 Entry.AddressEntryUserType = olExchangeUserAddressEntry 那麼

設置 olkEnt = Entry.GetExchangeUser

GetAddress = olkEnt.PrimarySmtpAddress

其他

GetAddress = 條目.地址

如果結束

最終選擇

在錯誤轉到0

設置 olkEnt = 無

函數結束



函數 GetRecipientsName(Item As MailItem, rcpType As Integer, Ret As Integer, intOutlookVersion As Integer) As String

將 xRcp 調暗為收件人

將 xNames 調暗為字符串

xNames = ""

對於 Item.Recipients 中的每個 xRcp

如果 xRcp.Type = rcpType 那麼

如果 Ret = 1 那麼

如果 xNames = "" 那麼

xNames = xRcp.Name

其他

xNames = xNames & "; " & xRcp.Name

如果結束

ElseIf Ret = 2 那麼

如果 xNames = "" 那麼

xNames = GetAddress(xRcp.AddressEntry, intOutlookVersion)

其他

xNames = xNames & "; " & GetAddress(xRcp.AddressEntry, intOutlookVersion)

如果結束

ElseIf Ret = 3 那麼

如果 xNames = "" 那麼

xNames = xRcp.AddressEntry.Type

其他

xNames = xNames & "; " & xRcp.AddressEntry.Type

如果結束

如果結束

ElseIf xRcp.Type = rcpType 然後

如果 Ret = 1 那麼

如果 xNames = "" 那麼

xNames = xRcp.Name

其他

xNames = xNames & "; " & xRcp.Name

如果結束

ElseIf Ret = 2 那麼

如果 xNames = "" 那麼

xNames = GetAddress(xRcp.AddressEntry, intOutlookVersion)

其他

xNames = xNames & "; " & GetAddress(xRcp.AddressEntry, intOutlookVersion)

如果結束

ElseIf Ret = 3 那麼

如果 xNames = "" 那麼

xNames = xRcp.AddressEntry.Type

其他

xNames = xNames & "; " & xRcp.AddressEntry.Type

如果結束

如果結束

ElseIf xRcp.Type = rcpType 然後

如果 Ret = 1 那麼

如果 xNames = "" 那麼

xNames = xRcp.Name

其他

xNames = xNames & "; " & xRcp.Name

如果結束

ElseIf Ret = 2 那麼

如果 xNames = "" 那麼

xNames = GetAddress(xRcp.AddressEntry, intOutlookVersion)

其他

xNames = xNames & "; " & GetAddress(xRcp.AddressEntry, intOutlookVersion)

如果結束

ElseIf Ret = 3 那麼

如果 xNames = "" 那麼

xNames = xRcp.AddressEntry.Type

其他

xNames = xNames & "; " & xRcp.AddressEntry.Type

如果結束

如果結束

如果結束

下一頁

GetRecipientsName = xNames

函數結束




希望這對你有用。
阿曼達
網站主持人對此評論進行了最小化
在 ExporttoExcel 子中,您可以添加正文

'寫入 Excel 列標題
與 excWks
.Cells(1, 1) = "主題"
.Cells(1, 2) = "收到"
.Cells(1, 3) = "發件人"
.Cells(1, 4) = "身體"
結束
整數行 = 2
對於 olkFld.Items 中的每個 olkMsg
'只導出消息,不導出收據或約會請求等。
如果 olkMsg.Class = olMail 那麼
'為要導出的消息中的每個字段添加一行
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow,3)= GetSMTPAddress(olkMsg,intVersion)
excWks.Cells(intRow, 4) = olkMsg.Body
整數行 = 整數行 + 1
網站主持人對此評論進行了最小化
嗨,希望有人可以在這裡幫助我,我對 VB 幾乎一無所知,但到目前為止已經設法讓這個腳本為我工作。

但是,我的收件箱下總共有大約 1500 個文件夾和子文件夾,我真的想要一個簡單的腳本來導出我發送到的所有電子郵件地址,主題行和日期在 Excel 中的單獨列上。

我已經搜索了好幾天,並嘗試了許多不同的站點,但除了這個之外,沒有任何代碼可以工作。


我所要求的甚至可能嗎? 如果是這樣,有沒有足夠善良和聰明的人來幫助我編寫我需要的腳本?
我認為這與這部分有關:


子導出主()

ExportToExcel "destination_folder_path\A.xlsx", "your_email_accouny\folder\subfolder_1"

ExportToExcel "destination_folder_path\B.xlsx", "your_email_accouny\folder\subfolder_2"

MsgBox "進程完成。", vbInformation + vbOKOnly, MACRO_NAME

END SUB


在先進的感謝
網站主持人對此評論進行了最小化
嗨,
我剛剛運行了這個運行良好的宏。
我明白在表達式中
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow,3)= GetSMTPAddress(olkMsg,intVersion)

olkMsg.* 和 GetSMTPAddress(olkMsg, intVersion) 從 Outlook 中提取內容。

用於獲取郵件發送到的地址的參數是什麼?

使用 Outlook 的導出嚮導時,可以導出此地址,因此我認為可以通過此宏(稍作修改)來完成。
有人可以幫助嗎?

問候
網站主持人對此評論進行了最小化
我運行此宏但不斷收到編譯錯誤:

用戶=未定義類型

在第 62 行“Public Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder”

我已經指定瞭如下路徑:

ExportToExcel "C:\Users\kudus\Documents\MailExportTest\f1\A.xlsx", "myname@mydomain.com\Inbox\Black Hat 網絡廣播"
ExportToExcel "C:\Users\\Documekudus\Documents\MailExportTest\f2\B.xlsx", "myname@mydomain.com\Inbox\CPD\Kaplan Training"

如果需要,我正在使用 Outlook 2016
網站主持人對此評論進行了最小化
我修好了它。 在 Visual Basic 窗口中,轉到工具 參考 - 和“Microsoft Outlook 16.0 對像庫”框

這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護