アウトルックの受信メールを読む

Option Explicit

Private Sub CommandButton1_Click()
    Dim tol As Outlook.Application
    Dim tns As Object
    Dim toldir As Object
    Dim tSyncObj As Outlook.SyncObject
    Dim tmail As Object
    Dim i As Integer
    Dim lrow As Long
    
    'Outlookのインスタンスを作成
    Set tol = New Outlook.Application
    '名前空間を取得
    Set tns = tol.GetNamespace("MAPI")
    '受信トレイを取得
    Set toldir = tns.GetDefaultFolder(olFolderInbox)
    '受信トレイを表示
    toldir.Display
    
    '項目名の表示
    lrow = 6
    Cells(lrow, 2) = "件名"
    Cells(lrow, 3) = "未読"
    Cells(lrow, 4) = "本文"
        
    'アイテム数をループする
    For i = 1 To toldir.Items.Count
        'アイテムオブジェクト
        Set tmail = toldir.Items.Item(i)
        
        lrow = lrow + 1
        '件名
        Cells(lrow, 2) = tmail.Subject
        '未読
        Cells(lrow, 3) = tmail.UnRead
        '本文
        Cells(lrow, 4) = tmail.Body
        
        Set tmail = Nothing
    Next
    
    DoEvents
    
    Set toldir = Nothing
    Set tns = Nothing
    'OutLookを閉じる
    tol.Quit
    Set tol = Nothing
    
End Sub