OutlookのVBAについて教えてください
はじめまして。
Outlookにて仕訳ルールの処理にて
特定のアドレスの方からのメールを仕訳け、さらに
添付ファイルを保存する。という処理を行っています。
添付ファイルの保存自体はネットでのVBAを参考に
作成することができました。
ただ、OutLook起動時に複数件、同じメールがある場合、
一番古いメールの添付ファイルのみが保存されてしまっているようです。
解決方法がわかる方、教えてください。
やりたいことは以下のとおりです。
宜しくお願い致します。
■実現したいこと
・件名Aのメールの場合：添付ファイルをフォルダーAへ保存
・件名Bのメールの場合：添付ファイルをフォルダーBへ保存
・件名Cのメールの場合：添付ファイルをフォルダーCへ保存
・件名Dのメールの場合：添付ファイルをフォルダーDへ保存
■OutLookのVBA
Public Sub SaveAttachments(objMsg As MailItem)
Const SAVE_Dir = "C:\"
Dim objFSO As Object
Dim objAttach As Attachment
Dim strFileName As String
Dim c As Integer: c = 1
Dim flg As Integer: flg = 1
Dim SAVE_PATH As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
' 件名により、保存先のパスを変更します。
SAVE_PATH = SAVE_Dir
If VBA.Right(SAVE_PATH, 1) <> "\" Then SAVE_PATH = SAVE_PATH & "\"
Select Case objMsg.Subject
Case "件名A"
SAVE_PATH = SAVE_PATH & "フォルダーA"
Case "件名B"
SAVE_PATH = SAVE_PATH & "フォルダーB"
Case "件名C"
SAVE_PATH = SAVE_PATH & "フォルダーC"
Case "件名D"
SAVE_PATH = SAVE_PATH & "フォルダーD"
Case Else
flg = 0
End Select
If VBA.Right(SAVE_PATH, 1) <> "\" Then SAVE_PATH = SAVE_PATH & "\"
' 指定のフォルダに添付ファイルを格納
If flg = 1 Then
For Each objAttach In objMsg.Attachments
With objAttach
strFileName = SAVE_PATH & objAttach.FileName
.SaveAsFile strFileName
End With
Next
End If
End Sub
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_3_thumbnail_img_sm.png)
