[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『メール添付ファイル一括保存マクロに条件付けを追加したい』(ペヤング)
当日に指定のメールアドレスに届いた添付ファイルをまとめて保存したかったため、以下のようなマクロを作成しました。
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 >
(tkit) 2021/11/24(水) 15:36
■1
こだわりが無ければ、インデントを付けた方がコード全体の構造が把握しやすくなり、ご自身のデバッグ作業の効率アップに繋がると思います。
■2
ここは【エクセル】に関する質問掲示板です。
提示されたコードは、実質outlookしか操作してないのでOutlookに対応したフォーラムに移動されるとともに、研究もOutlookVBAのほうでされたほうが色々悩まずに済むように思います。
(もこな2) 2021/11/24(水) 16:26
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.