VBA 宏自动列出 Excel 中 Outlook 中收到的电子邮件
本文推荐给以下人群：
- 想要在 Excel 中列出 Outlook 中收到的电子邮件的用户
- 想要简化电子邮件管理的人
- 想学习宏提高工作效率的人
来自客户的询问、来自业务合作伙伴的联系以及来自公司内部的电子邮件请求每天都会堆积在您的收件箱中。
您是否发现搜索所需信息非常耗时，并且您是否忽略了重要的任务？
许多工作场所的一个常见问题是，您收到的电子邮件越多，搜索和整理它们所需的时间就越多，从而难以快速响应并做出准确的决策。
这里有帮助的是VBA 宏自动在 Excel 中列出 Outlook 电子邮件是。
如果安装此软件，只需单击一下即可以 Excel 格式显示主题、发件人、收件人、接收日期和时间以及文本等信息。
如果您使用Excel，您可以轻松执行灵活的操作，例如立即按客户名称或项目关键字过滤以提取必要的电子邮件，或按接收日期和时间排序以防止遗漏。
自动保存 Outlook 中收到的电子邮件附件的宏如果和它结合起来会更方便
目录
准备事项及基本流程
要使用此 VBA 宏，具有 Windows 版本的 Outlook 和 Excel 的 PC 环境就足够了。是。
不需要特殊的开发工具。您可以按照以下步骤立即使用它。
- 单击“开发工具”选项卡打开 Visual Basic
- 粘贴指定的代码并单击 ✕ 关闭 Visual Basic
- 单击“文件”→“另存为”，选择“Excel 启用宏的工作簿（.xlsm）”作为文件类型，然后保存。
- 在“开发人员”选项卡中，单击“显示宏”，选择“获取 Outlook 电子邮件列表”，然后单击“运行”。
- 当“处理完成”时。显示，点击“确定”
- 确认 Outlook 电子邮件显示在 Excel 的列表中
要启用宏，将 Excel 文件另存为“启用宏的工作簿 (.xlsm)”非常重要是。
接下来，我们将使用实际屏幕以易于理解的方式说明从准备 Excel 工作簿到执行宏的过程。
步单击 Excel 中的“开发人员”选项卡
启动 Excel 并单击“开发人员”选项卡。
如果您在 Excel 中没有看到“开发人员”选项卡，请参阅以下如何添加“开发人员”选项卡以在 Excel 中创建宏和表单请参考此处显示“开发”选项卡。
步单击“Visual Basic”
接下来，在“开发人员”选项卡中，单击“Visual Basic”请。
如何在Excel中引入VBA宏自动列出Outlook电子邮件第2步单击“Visual Basic”
步点击“本工作簿”
单击左上框中的“Visual Basic”点击“本工作簿”请。
当您单击“此工作簿”时，右侧将为空白，如下图所示。
如何引入VBA宏在Excel中自动列出Outlook电子邮件第3步单击“此工作簿”
步粘贴代码并点击右上角的“✕”
在右侧的纯白色区域，如下粘贴代码请。
粘贴后点击右上角“✕”请。
Option Explicit
'-----------------------------------------
' このマクロは、Outlookから指定のフォルダ内のメールおよび開封通知(ReportItem)を取得し、
' Excelシートに一覧として蓄積します。
'
' 【主な特徴】
' - ユーザーが事前に指定したアカウント名とフォルダ名に基づいてメールを取得
' - すでに取得済み(EntryIDで判断)のメールは重複して取得しない
' - メール取得後、受信日時(またはReportItemの場合CreationTime)でソート
' - メールの本文はテキスト形式(Body)で取得
' - シート「メール一覧」にデータを蓄積
'
' ※実行前にOutlookを起動し、Excelは「メール一覧.xlsm」などマクロ有効ブックで本コードを保存しておくと便利です。
'-----------------------------------------
Sub Outlookのメール一覧取得()
'===============================
'【ユーザー指定項目：ここを事前設定してください】
'===============================
' 特定のアカウント名でメールを絞りたい場合に記入
' 例: "[email protected]" あるいは Outlookに表示されているアカウント表示名
' 空欄の場合、全てのアカウントを対象とします。
Const TARGET_ACCOUNT_NAME As String = ""
' 出力先シート名（このブック内に存在するか、新規作成します）
Const OUTPUT_SHEET_NAME As String = "メール一覧"
' 取得したいOutlookフォルダパス
' 例1: "Inbox" → 受信トレイ
' 例2: "Sent Items" → 送信済みアイテム
' 例3: "InboxProcessed" → 受信トレイ配下にある"Processed"フォルダ
' 空欄の場合は既定の受信トレイが対象になります
Const TARGET_FOLDER_PATH As String = "Inbox"
'===============================
'【ここまでユーザー指定項目】
'===============================
Dim OutlookApp As Object ' Outlook.Applicationを遅延バインディングで取得
Dim OutlookNS As Object ' Outlook.Namespace
Dim st As Object ' Outlook.Store
Dim targetFolder As Object ' 取得対象のフォルダ
Dim itm As Object ' 各アイテム(MailItem/ReportItem)
Dim mailItem As Object ' MailItem専用
Dim reportItem As Object ' ReportItem専用
Dim wb As Workbook ' 本ブック
Dim ws As Worksheet ' 出力先シート
Dim lastRow As Long ' データ書き込み先行
Dim attachmentsList As String ' 添付ファイル一覧文字列
Dim existingIDs As Object ' EntryID重複チェック用Dictionary
Dim r As Long, idCheckRow As Long
Dim j As Long
Set wb = ThisWorkbook
' シート取得または作成
On Error Resume Next
Set ws = wb.Sheets(OUTPUT_SHEET_NAME)
On Error GoTo 0
If ws Is Nothing Then
Set ws = wb.Worksheets.Add
ws.Name = OUTPUT_SHEET_NAME
End If
' 最終行取得
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If lastRow < 1 Then lastRow = 1
' ヘッダー設定
ws.Cells(1, 1).Value = "アカウント名"
ws.Cells(1, 2).Value = "送信者表示名"
ws.Cells(1, 3).Value = "送信者メールアドレス"
ws.Cells(1, 4).Value = "宛先"
ws.Cells(1, 5).Value = "CC"
ws.Cells(1, 6).Value = "件名"
ws.Cells(1, 7).Value = "本文(テキスト形式)"
ws.Cells(1, 8).Value = "添付ファイル名"
ws.Cells(1, 9).Value = "受信日時相当"
ws.Cells(1, 10).Value = "EntryID"
' 既存EntryID取得
Set existingIDs = CreateObject("Scripting.Dictionary")
For idCheckRow = 2 To lastRow
If Not IsEmpty(ws.Cells(idCheckRow, 10).Value) Then
existingIDs(ws.Cells(idCheckRow, 10).Value) = True
End If
Next idCheckRow
' Outlook起動
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookNS = OutlookApp.GetNamespace("MAPI")
' 指定フォルダ取得
Set targetFolder = GetOutlookFolder(OutlookNS, TARGET_ACCOUNT_NAME, TARGET_FOLDER_PATH)
If targetFolder Is Nothing Then
MsgBox "指定したフォルダが見つかりませんでした。" & vbCrLf & _
"アカウント名やフォルダ名を再確認してください。", vbExclamation
GoTo Cleanup
End If
' アイテム列挙
For Each itm In targetFolder.Items
Select Case TypeName(itm)
Case "MailItem"
Set mailItem = itm
If existingIDs.Exists(mailItem.EntryID) Then GoTo NextItem
Dim mSenderName As String, mSenderEmail As String
mSenderName = mailItem.SenderName
mSenderEmail = mailItem.SenderEmailAddress
' 本文はテキスト形式
Dim mailBody As String
On Error Resume Next
mailBody = mailItem.Body
On Error GoTo 0
' 添付ファイル名取得
attachmentsList = ""
If mailItem.Attachments.Count > 0 Then
For j = 1 To mailItem.Attachments.Count
attachmentsList = attachmentsList & mailItem.Attachments(j).FileName & "; "
Next j
If Right(attachmentsList, 2) = "; " Then
attachmentsList = Left(attachmentsList, Len(attachmentsList) - 2)
End If
End If
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
ws.Cells(lastRow, 1).Value = targetFolder.Store.DisplayName
ws.Cells(lastRow, 2).Value = mSenderName
ws.Cells(lastRow, 3).Value = mSenderEmail
ws.Cells(lastRow, 4).Value = mailItem.To
ws.Cells(lastRow, 5).Value = mailItem.CC
ws.Cells(lastRow, 6).Value = mailItem.Subject
ws.Cells(lastRow, 7).Value = mailBody
ws.Cells(lastRow, 8).Value = attachmentsList
ws.Cells(lastRow, 9).Value = mailItem.ReceivedTime
ws.Cells(lastRow, 10).Value = mailItem.EntryID
existingIDs(mailItem.EntryID) = True
Case "ReportItem"
Set reportItem = itm
If existingIDs.Exists(reportItem.EntryID) Then GoTo NextItem
attachmentsList = ""
If reportItem.Attachments.Count > 0 Then
For j = 1 To reportItem.Attachments.Count
attachmentsList = attachmentsList & reportItem.Attachments(j).FileName & "; "
Next j
If Right(attachmentsList, 2) = "; " Then
attachmentsList = Left(attachmentsList, Len(attachmentsList) - 2)
End If
End If
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
ws.Cells(lastRow, 1).Value = targetFolder.Store.DisplayName
ws.Cells(lastRow, 2).Value = ""
ws.Cells(lastRow, 3).Value = ""
ws.Cells(lastRow, 4).Value = ""
ws.Cells(lastRow, 5).Value = ""
ws.Cells(lastRow, 6).Value = reportItem.Subject
ws.Cells(lastRow, 7).Value = ""
ws.Cells(lastRow, 8).Value = attachmentsList
ws.Cells(lastRow, 9).Value = reportItem.CreationTime
ws.Cells(lastRow, 10).Value = reportItem.EntryID
existingIDs(reportItem.EntryID) = True
Case Else
' その他は無視
End Select
NextItem:
Next itm
' ソート(受信日時相当:9列目)
Dim lastDataRow As Long
lastDataRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If lastDataRow > 1 Then
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=ws.Range("I2:I" & lastDataRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
.SetRange ws.Range("A1:J" & lastDataRow)
.Header = xlYes
.Apply
End With
End If
' 保存
wb.Save
MsgBox "処理が完了しました。指定フォルダ(" & TARGET_FOLDER_PATH & ")からメールを取得・一覧化しました。", vbInformation
Cleanup:
Set reportItem = Nothing
Set mailItem = Nothing
Set targetFolder = Nothing
Set OutlookNS = Nothing
Set OutlookApp = Nothing
Set ws = Nothing
Set wb = Nothing
Set existingIDs = Nothing
End Sub
Private Function GetOutlookFolder(ByVal oNS As Object, ByVal accountName As String, ByVal folderPath As String) As Object
Dim st As Object
Dim f As Object
Dim subFolders() As String
Dim i As Long
If folderPath = "" Then
' フォルダパスが空ならデフォルト受信トレイ
For Each st In oNS.Stores
If accountName = "" Or InStr(st.DisplayName, accountName) > 0 Then
On Error Resume Next
Set f = st.GetDefaultFolder(6) ' 6 = olFolderInbox
On Error GoTo 0
If Not f Is Nothing Then
Set GetOutlookFolder = f
Exit Function
End If
End If
Next st
Exit Function
End If
subFolders = Split(folderPath, "")
For Each st In oNS.Stores
If accountName = "" Or InStr(st.DisplayName, accountName) > 0 Then
If subFolders(0) = "Inbox" Then
On Error Resume Next
Set f = st.GetDefaultFolder(6) ' Inbox
On Error GoTo 0
ElseIf subFolders(0) = "Sent Items" Then
On Error Resume Next
Set f = st.GetDefaultFolder(5) ' Sent Items
On Error GoTo 0
Else
Set f = GetFolderByName(st, subFolders(0))
End If
If f Is Nothing Then GoTo NextStore
For i = 1 To UBound(subFolders)
Set f = f.Folders(subFolders(i))
If f Is Nothing Then Exit For
Next i
If Not f Is Nothing Then
Set GetOutlookFolder = f
Exit Function
End If
End If
NextStore:
Next st
End Function
Private Function GetFolderByName(ByVal st As Object, ByVal folderName As String) As Object
Dim f As Object
For Each f In st.GetRootFolder.Folders
If f.Name = folderName Then
Set GetFolderByName = f
Exit For
End If
Next f
End Function
如何在Excel中引入VBA宏自动列出Outlook电子邮件第4步粘贴代码并单击右上角的“✕”
步点击“文件”
单击右上角的“✕”可返回正常的 Excel 屏幕。
接下来是左上角点击“文件”请。
如何引入VBA宏在Excel中自动列出Outlook电子邮件第5步单击“文件”
步点击“另存为”
单击“文件”进入 Excel 主屏幕。
在其中点击“另存为”请。
如何引入VBA宏在Excel中自动列出Outlook电子邮件第6步单击“另存为”
步输入文件名，选择“Excel启用宏的工作簿（.xlsm）”，然后单击“保存”
单击“另存为”将进入左上角显示“另存为”的屏幕。
第一的，输入文件名请。
*请选择一个容易理解的名称。
然后在其下的文件类型中选择“Excel启用宏的工作簿（.xlsm）”，然后单击“保存”请。
如何在Excel中引入VBA宏自动列出Outlook电子邮件第7步输入文件名，选择“Excel启用宏的工作簿（.xlsm）”，然后单击“保存”
步单击“开发人员”选项卡中的“宏”
单击“保存”返回正常的 Excel 屏幕。
如果您在运行宏之前启动 Outlook 并接收最新的电子邮件，将会更顺利。
接下来，在“开发”选项卡中点击“宏”请。
如何在Excel中引入VBA宏自动列出Outlook电子邮件第8步在“开发”选项卡中单击“宏”
步选择“获取 Outlook 电子邮件列表”并单击“运行”
单击“宏”，将弹出一个标有“宏”的小窗口。
在其中选择“获取 Outlook 电子邮件列表”并单击“运行”请。
如果执行宏时出现“宏执行已被阻止”的信息，请单击此处。看看该怎么做。
如何引入VBA宏在Excel中自动列出Outlook电子邮件第9步选择“获取Outlook电子邮件列表”，然后单击“运行”
步点击“确定”
单击“运行”，Excel 将开始从 Outlook 检索电子邮件列表。
获取完成后，“处理完成”。显示。
单击“确定”关闭窗口。
如何引入VBA宏在Excel中自动列出Outlook电子邮件第10步单击“确定”
步确认 Outlook 电子邮件在 Excel 中显示为列表
您的 Outlook 电子邮件现在将在 Excel 中显示为列表。
如何引入VBA宏在Excel中自动列出Outlook电子邮件Step11确认Outlook电子邮件在Excel中显示为列表
安装前您应了解的先决条件和限制
我们将总结您在实施之前应了解的先决条件和限制。
- 仅适用于来自同一登录帐户的电子邮件
这仅适用于可以使用您当前登录的 Outlook 帐户访问的电子邮件。您无法列出您没有权限的其他人的邮箱或共享电子邮件。 - 仅适用于 Outlook 中已收到的电子邮件
该宏引用 Outlook 已收到的电子邮件。如果 Outlook 未启动或接收过程未完成，您将无法检索电子邮件。在继续操作之前，启动 Outlook 并接收新电子邮件非常重要。 - 基本在Windows环境下使用
由于 VBA 基于 Windows 版本的 Office，因此在其他环境（例如 Mac 或 Web 版本的 Outlook）中，行为可能会发生变化。如果您使用的是Windows版本的Outlook和Excel，应该没有问题。 - 文件夹名称和语言设置
标准文件夹名称（例如“收件箱”和“已发送邮件”）可能会有所不同，具体取决于您的语言设置。代码中指定的文件夹名称可能需要修改以匹配实际环境。 - Outlook 和 Excel 在同一台 PC 上运行
由于我们采用的是 Outlook 和 Excel 在本地环境中协同工作的机制，因此我们不假设通过云端直接从另一台 PC 检索电子邮件等操作。
这个宏有很多技巧，对你的日常工作非常有用。
第一的，防止重复检索电子邮件由于该机制，即使您每天运行宏，您也不必担心相同的电子邮件继续增加。
通过使用特定于电子邮件的 ID 并且导入后不再添加电子邮件，列表始终保持易于理解的状态。您还可以每天早上运行宏来仅添加新电子邮件。
下一个，文件夹规格可灵活更改。除了定位收件箱之外，您还可以浏览已发送的项目和特定项目的子文件夹。
如果您为每个客户或项目都有单独的文件夹，您将能够通过仅检索您需要的信息来提高工作效率。
获取正文时，会删除HTML标签等不必要的元素，并以文本格式导入内容，因此可以作为纯文本进行检查。
这样可以轻松理解电子邮件的内容并通过复制和粘贴将其用于次要目的。
该代码带有注释，因此即使是初学者也可以通过最少的修改来根据自己的喜好对其进行自定义。
例如，逐步尝试其他应用程序是个好主意，例如更改工作表名称或根据特定条件过滤电子邮件。
通过首先使用基础知识并在习惯后逐渐改进它们，您可以创建一个完全适合您工作的系统。
有关自动列出 Excel 中 Outlook 中收到的电子邮件的 VBA 宏的常见问题和解答
我们总结了有关自动列出 Excel 中 Outlook 中收到的电子邮件的 VBA 宏的常见问题和解答。
即使我没有编程经验，我可以使用“VBA 宏”吗？
是的，可以通过复制粘贴的方式安装，所以即使是初学者也没有问题。不需要复杂的设置或特殊的开发工具。
如何在 Excel 中列出 Outlook 电子邮件？
如果您有 Windows 版本的 Outlook 和 Excel，则可以使用它。一般的办公环境就足够了。
我可以免费做吗？
如果您有 Windows 版本的 Outlook 和 Excel，则可以免费使用它。
Mac 版或网页版 Outlook 怎么样？
VBA 基于 Windows，因此它在 Mac 或 Outlook 的 Web 版本上的行为可能有所不同。推荐Windows环境。
尚未收到的新电子邮件是否被排除在外？
只能列出 Outlook 已收到的电子邮件。执行前请先启动Outlook并完成发送和接收。
我可以列出其他人的邮箱或文件夹中我无权访问的项目吗？
只有您登录的帐户可以查看的电子邮件才有资格。您不能列出其他人的电子邮件。
您是否担心重复电子邮件的增加？
引入的宏在导入后不会重新获取电子邮件，因此相同的电子邮件不会一遍又一遍地排列。
Excel可以自由排序和筛选吗？
是的，它可以用作常规 Excel 数据。
如果在 Excel 中删除一行会发生什么？
Excel 仅显示检索到的结果，因此删除行对 Outlook 没有影响。重新运行时，只会添加新电子邮件。
如果您在 Outlook 中删除电子邮件，Excel 会发生什么情况？
历史记录在 Excel 端独立保存。
当邮件很多时，速度会变慢吗？
如果数量过多，可能需要一些时间。
建议阅读：[Outlook] 通俗易懂讲解如何更改已发送邮件的字体和文字颜色
阅读大量 HTML 电子邮件不是很困难吗？
通过将其转换为文本来删除标签，因此即使是 HTML 电子邮件也可以轻松理解。
与 Outlook 和 Excel 相关的其他文章
单击此处查看与 Outlook 和 Excel 相关的其他文章。请看一下。
![[excel]如何一次删除空白行](https://jjgvkw.pfrlju.com/tech/eva/wp-content/uploads/cache/2025/05/スライド1-16.png)
