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 = 条目.地址

结束如果

CASE ELSE

如果 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 对象库”框

这里还没有评论

关注我们

版权所有 © 2009 - extendoffice.com。 | 版权所有。 供电 ExtendOffice。 | 网站地图
Microsoft和Office徽标是Microsoft Corporation在美国和/或其他国家的商标或注册商标。
受Sectigo SSL保护