Outlookで選択したメールのみ書き出すVBA

質問

こんにちは。
Outlookで選択したメールのみ書き出すVBAを教えてください。
下記のコードまでは作成ができ、書き出すことには成功しました。
ですが、下記コードだとフォルダ内すべてのメールが書き出しされてしまいます。

選択しているメールのみ書き出すコードに書き換えたいのですが、
どこを変えたらよいかわかりません。
どなたかご教示いただけると幸いです。

-------------------------------------------

Sub メール書き出し()
On Error Resume Next
Set myMFolder = Application.ActiveExplorer.CurrentFolder
Set xlApp = CreateObject("Excel.Application")
Set myBook = xlApp.Workbooks.Add
xlApp.Visible = True
With myBook.Worksheets(1)
i = 1
For Each myItem In myMFolder.Items

'受信日時
.Cells(i, 1) = myItem.ReceivedTime
'受信者名
.Cells(i, 2) = myItem.Recipients(1).Name
'件名
.Cells(i, 3) = myItem.Subject
'送信者名
.Cells(i, 4) = myItem.SenderName
'受信者名
.Cells(i, 5) = myItem.Recipients(1).Addresss

i = i + 1
Next myItem
End With
Set xlApp = Nothing
End Sub

回答No.1

m3_maki · ベストアンサー

こんばんは。
こんな感じで。

On Error Resume Next
Set mySelection = Application.ActiveExplorer.Selection '変更
Set xlApp = CreateObject("Excel.Application")
Set myBook = xlApp.Workbooks.Add
xlApp.Visible = True
With myBook.Worksheets(1)
i = 1
For Each myItem In mySelection '変更
・・・・

お礼

m3_makiさん

ありがとうございます！できました！！
これでかなりの時間を短縮できます。
早急なご対応ありがとうございました。