[[20211124145202]] 『メール添付ファイル一括保存マクロに条件付けを追』(ペヤング) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『メール添付ファイル一括保存マクロに条件付けを追加したい』(ペヤング)

当日に指定のメールアドレスに届いた添付ファイルをまとめて保存したかったため、以下のようなマクロを作成しました。

Sub test()

Const fpath As String = "保存先フォルダのパス"
Dim indh As String
Dim dh As Date
Dim oApp As Object
Dim infol As Object
Dim omail As Object
Dim i As Integer
Dim atno As Integer
Dim cnt As Integer

Do Until IsDate(indh)
indh = DateAdd("d", 0, Date)
Loop

dh = CDate(indh)
Application.ScreenUpdating = False
Set oApp = CreateObject("Outlook.Application")
Set infol = oApp.GetNamespace("MAPI").Folders("指定のメールアドレス").Folders("受信トレイ")
For Each omail In infol.Items
With omail

If .ReceivedTime >= dh Then
atno = .Attachments.Count
If atno <> 0 Then
For i = 1 To atno
.Attachments(i).SaveAsFile (fpath & .Attachments(i).DisplayName)
cnt = cnt + 1
Next i
End If
End If
End With

Next omail
Set oApp = Nothing
Set oSpc = Nothing
Set omail = Nothing
Application.ScreenUpdating = True

If cnt = 0 Then

MsgBox "添付ファイルはありませんでした。"

Else

MsgBox "添付ファイルの保存が完了しました。"

End If
End Sub

このままでも添付ファイルをまとめて保存してくれるのですが、不要な添付ファイルもまとめて保存してしまうため、特定のメールアドレスから届いたもののみ保存するように改良したいです。
ご助力をよろしくお願い致します。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


omailのプロパティの.SenderEmailAddressで送信先アドレスが取得できますので、
あとは比較して該当するアドレスのみ処理すればいいでしょう。
コード改変についてはご自身でお願いします。

(tkit) 2021/11/24(水) 15:36


質問の答えではないですが。

■1
こだわりが無ければ、インデントを付けた方がコード全体の構造が把握しやすくなり、ご自身のデバッグ作業の効率アップに繋がると思います。

■2
ここは【エクセル】に関する質問掲示板です。
提示されたコードは、実質outlookしか操作してないのでOutlookに対応したフォーラムに移動されるとともに、研究もOutlookVBAのほうでされたほうが色々悩まずに済むように思います。

(もこな2) 2021/11/24(水) 16:26


>>tkit様

If .ReceivedTime >= dh Then
の下に
If .SenderEmailAddress = 該当のアドレス Then
を加えて上手く行きました。ありがとうございました。

>>もこな2様
申し訳ございません。次からはOutlookVBAの質問掲示板で相談したいと思います。
(ペヤング) 2021/11/25(木) 14:52


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.