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 相關的其他文章。請看一下。
![[Microsoft Edge]如何阻止網站上的廣告](https://jjgvkw.pfrlju.com/tech/eva/wp-content/uploads/cache/2025/05/スライド1-22.png)
