下記の質問をいただく
>OUTLOOKで受信したメールで作業実施日を毎朝8時とすると
>そこからからマイナス15時間から朝8時の範囲で受信したメールだけを
>任意のサブフォルダーに移したいときはどのようにすればよいのでしょうか。
.ReceivedTime で受信時刻がわかるので、
.Move してみただけですが
下記、メール移動のサンプルコードです
参考となれば・・・
Option Explicit '2021-04-08 .Move でメールを移動させる 'カウンターを使用して、後ろからメールを処理する Sub outlook_test20210408_001() 'サブフォルダからメールを読み込み 移動させる Dim oNamespace As NameSpace Dim oFolder As Outlook.Folder 'フォルダー ' NameSpace オブジェクトへの参照を取得します。 Set oNamespace = Application.GetNamespace("MAPI") ' 既定のフォルダへの参照を取得し、フォルダを表示します。 Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox) '受信トレイを指定 oFolder.Display '選択したフォルダーの表示 Dim mITEM As Outlook.MailItem 'メールアイテム Dim nMAILCNT As Integer 'メールの位置 2019/06/06 追加 'テストで名前の表示 Debug.Print oFolder.Name 'メールアイテムの処理 受信トレイがoFolderなので.Itemsで指定 'メールの件数が .Count でわかるので、後ろから処理する For nMAILCNT = oFolder.Items.Count To 1 Step -1 Set mITEM = oFolder.Items(nMAILCNT) 'アイテムを代入 '↑.Item(nMAILCNT)の代入が終わったので、各プロパティに mITEM.XXXX で アクセスする 'デバッグでイミディエイトに表示 Debug.Print "件名:" & mITEM.Subject '件名表示 Debug.Print "受信日時:" & mITEM.ReceivedTime '受信日時 'メールを移動 '受信日時を条件にして移動する '※6 ループの中で移動させる時は注意 '受信日時 <= 15時間前の 過去メールなら、処理MOVETEST フォルダへ移動 If mITEM.ReceivedTime <= DateAdd("h", -15, Now()) Then mITEM.Move oFolder.Folders("処理MOVETEST") '受信トレイの下 処理MOVETEST Debug.Print ".move実行" End If Debug.Print "" Next '使用したオブジェクトの解放 = Nothing Set mITEM = Nothing Application.ActiveExplorer.Close '新しく開いてしまったフォルダーを閉じる Set oFolder = Nothing Set oNamespace = Nothing MsgBox "処理終了" End Sub
あっ
>そこからからマイナス15時間から朝8時の範囲で受信したメールだけを
'受信日時 <= 15時間前の 過去メールなら、処理MOVETEST フォルダへ移動
If mITEM.ReceivedTime <= DateAdd("h", -15, Now()) Then
↑当日、朝の八時の細工が必要ですね・・・
条件も逆ですね
'15時間前 <= 受信日時 <= 朝8時 の メールなら、処理MOVETEST フォルダへ移動
If DateAdd("h", -15, Now()) <= mITEM.ReceivedTime And mITEM.ReceivedTime <= 朝八時 Then
の条件にしないとダメですね。
メールの移動 .Moveは、後ろからループで処理しないと失敗するので
↓手前味噌ですが、下記の動画を暇な時みて笑ってください
www.youtube.com
https://www.youtube.com/watch?v=I4XZYWltfqA
↑ループ中にコレクションの内容が変化すると、不具合が起きます
やりたい作業、処理の参考となれば幸いです。 三流プログラマー Ken3
似たような処理
ken3memo.hatenablog.com
です。