Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11全般 : Microsoft 365)
Outlookメールの受信トレイの取得する期間設定
投稿日時: 24/08/05 13:43:19
投稿者: gacha

現在、Outlookメールの受信トレイの取得をするにあたり、
下記のようなコードでマクロを調べました。
(ネットから情報を得たので、作ってはおりません。申し訳ございません。)
 
受信トレイのメール件数が多く、
xxxx年xx月xx日〜yyyy年yy月yy日
というように日付を設定して情報を取得したいのですが、
どのように組み込めば良いかが分からずで、
アドバイスを頂けますと助かります。
 
何卒、よろしくお願いします。
 

Sub 受信トレイ取得()

    Dim ol As Object, ns As Object
    Dim ib As Object, i As Long, r As Long
    
    Set ol = CreateObject("Outlook.Application")
    Set ns = ol.GetNamespace("MAPI")
    Set ib = ns.GetDefaultFolder(6)
    
    r = 3
    Rows(r & ":" & Rows.Count).ClearContents
    
    For i = 1 To ib.Items.Count

        With ActiveSheet
            .Cells(r, 1).Value = ib.Items(i).ReceivedTime
            .Cells(r, 2).Value = ib.Items(i).SenderName
            .Cells(r, 3).Value = ib.Items(i).Subject
            .Cells(r, 4).Value = 本文整形(ib.Items(i).Body)
            r = r + 1
        End With
    Next i


    
    
    MsgBox "取得が完了しました"

End Sub

回答
投稿日時: 24/08/05 17:21:09
投稿者: QooApp

単純に日付範囲指定についてVB内で定義するならば以下のような書式で動作しますが、
Outlookが事前に読み込んでいない古い範囲(例えば1カ月しか読み込んでないのに、4カ月前の範囲を読み込むなど)を指定するとエラーになるかも。詳しく検証していないのであくまでもとりあえずの話。
 

Option Explicit

Sub GetEmailsByDateRange()
    Dim outlookApp As Outlook.Application
    Dim inbox As Outlook.MAPIFolder
    Dim mailItem As Outlook.mailItem
    Dim items As Outlook.items
    Dim filteredItems As Outlook.items
    Dim i As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim filter As String
    
    ' 初期化
    Set outlookApp = New Outlook.Application
    Set inbox = outlookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    ' 検索する日付範囲を設定
    startDate = DateValue("2024-08-01") ' ここに開始日を入力
    endDate = DateValue("2024-08-04")   ' ここに終了日を入力
    
    ' 日付範囲フィルターを作成
    filter = "[ReceivedTime] >= '" & Format(startDate, "ddddd h:nn AMPM") & "' AND [ReceivedTime] <= '" & Format(endDate + 1, "ddddd h:nn AMPM") & "'"
    
    ' 受信トレイのアイテムを取得し、フィルターを適用
    Set items = inbox.items
    items.Sort "[ReceivedTime]", True
    Set filteredItems = items.Restrict(filter)
    
    ' フィルタリングされたメールを処理
    For i = 1 To filteredItems.Count
        
        ' mailItem型以外(ミーティングスケジュール通知等)を除外してメールのみ取得
        If TypeOf filteredItems.item(i) Is Outlook.mailItem Then
            
            Set mailItem = filteredItems.item(i)
            Debug.Print "Subject: " & mailItem.Subject
            Debug.Print "Received: " & mailItem.ReceivedTime
            Debug.Print "Sender: " & mailItem.SenderName
            Debug.Print "-----------------------------------"
            
        End If
        
    Next i
End Sub

回答
投稿日時: 24/08/05 17:24:10
投稿者: QooApp

注釈追記
Outlook側のVBAで実行する関数です。
エクセル側のVBAの質問掲示板に書き込まれているのでもしかしたらExcel側の制御を希望しているかもしれませんが、とりあえずOutlookで動作することを確認してください。
 
動作することが確認できればCSV書き出しするなりなんなりすればどうとでもなるはずと考えています。
一応VBA上で動作しているのでExcel側でも呼び出しできないこともないと思いますが、wordなどで専用の定義が呼び出せない前例を知っているのでおそらくExcel側で完全動作しないかもしれません。

投稿日時: 24/08/27 20:58:14
投稿者: gacha

>QooApp様
遅くなりしたが、回答ありがとうございます。
提示していただいたコードを使って、いろいろと試してみたいと思います。
感謝します。