Outlookの「受信日時」「件名」「本文」などをVBAを使ってExcelに転記したい

Outlookの「受信日時」「件名」「本文」などをVBAを使ってExcelに転記したいのですが、下記のコードですと、古い受信日時から1件しか取得できません。

出来れば、「受信トレイ」や「移動」「下書」きなどの取得したいフォルダーを選択し、新しい日付けから、「受信日時」「件名」「本文」を一括で
Excelに転記できるVBAコードに設定にして頂けると助かります。

よろしくお願いいたします。

VBAコードURL
https://writening.net/page?NWK5ZZ

No.2 ベストアンサー 回答者： kantansi 回答日時： 2024/02/11 11:04

以下は、Outlookから受信トレイ、移動、下書きなどのフォルダから新しい日付順に受信日時、件名、本文を一括でExcelに転記するVBAコードの例です。

このコードは、Outlookの既定のメールボックスからフォルダを選択し、そのフォルダ内のすべてのメールを取得します。

vba
Copy code
Sub ExportEmailsToExcel()
Dim OutlookApp As Object
Dim OutlookNamespace As Object
Dim Folder As Object
Dim Item As Object
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim RowIndex As Integer

' Outlookアプリケーションを作成
Set OutlookApp = CreateObject("Outlook.Application")
' Outlookの名前空間を取得
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

' Excelアプリケーションを作成
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True ' Excelを表示

' 新しいExcelブックを作成
Set xlWB = xlApp.Workbooks.Add
' Excelワークシートを取得
Set xlWS = xlWB.Sheets(1)

' Excelワークシートにヘッダーを書き込む
xlWS.Cells(1, 1).Value = "受信日時"
xlWS.Cells(1, 2).Value = "件名"
xlWS.Cells(1, 3).Value = "本文"

RowIndex = 2 ' データの書き込み開始行

' フォルダを選択
Set Folder = OutlookNamespace.PickFolder
If Not Folder Is Nothing Then
' フォルダ内のすべてのメールを処理
For Each Item In Folder.Items
' メールのタイプがメールである場合のみ処理
If TypeOf Item Is Outlook.MailItem Then
' Excelにデータを書き込む
xlWS.Cells(RowIndex, 1).Value = Item.ReceivedTime
xlWS.Cells(RowIndex, 2).Value = Item.Subject
xlWS.Cells(RowIndex, 3).Value = Item.Body
RowIndex = RowIndex + 1
End If
Next Item
End If

' メモリを解放
Set OutlookApp = Nothing
Set OutlookNamespace = Nothing
Set Folder = Nothing
Set Item = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlWS = Nothing
End Sub

このコードを実行すると、Outlookのフォルダを選択するダイアログが表示されます。選択したフォルダ内のすべてのメールがExcelに転記されます。

この回答へのお礼

お礼日時：2024/02/11 21:59