受信トレイメール情報取得

コード

Sub 受信トレイ取得()

Dim OL As Outlook.Application
Dim NS As Object
Dim Inbox As Object

Set OL = New Outlook.Application
Set NS = OL.GetNamespace("MAPI")
Set Inbox = NS.GetDefaultFolder(6)  '６が受信トレイ、５が送信済みトレイ

Dim i As Integer
i = 1

With Inbox
    For i = 1 To .Items.Count
        Cells(i, 1) = .Items(i).SentOn
        Cells(i, 2) = .Items(i).Subject
        Cells(i, 3) = .Items(i).SenderEmailAddress
        Cells(i, 4) = .Items(i).CC
        Cells(i, 5) = .Items(i).BCC
        'Cells(i, 6) = .Items(i).Body
    Next i
End With

End Sub

Sub 受信トレイサブフォルダ取得()

Dim OL As Outlook.Application
Dim NS As Object
Dim Inbox As Object
Dim subFolder As Object

Set OL = New Outlook.Application
Set NS = OL.GetNamespace("MAPI")
Set Inbox = NS.GetDefaultFolder(6)  '６が受信トレイ、５が送信済みトレイ

On Error Resume Next
Set subFolder = Inbox.Folders.Item(InputBox("サブフォルダ名を入力"))
If Err <> 0 Then
    MsgBox "サブフォルダの取得に失敗しました。"
    Exit Sub
End If
On Error GoTo 0


Dim i As Integer
i = 1

With subFolder
    For i = 1 To .Items.Count
        Cells(i, 1) = .Items(i).SentOn
        Cells(i, 2) = .Items(i).Subject
        Cells(i, 3) = .Items(i).SenderEmailAddress
        Cells(i, 4) = .Items(i).CC
        Cells(i, 5) = .Items(i).BCC
        'Cells(i, 6) = .Items(i).Body
    Next i
End With

End Sub

解説