Outlook VBAについてです！！

質問

アウトルックのVBAについて、教えてください！！

アウトルックのVBAについて、
受信と同時に添付ファイル（Excel）をフォルダに自動保存したいのですが下記条件があります。

１．添付ファイル名：*勤務管理*　（「勤務管理」を含むファイル名）
　　差出人：Aさんのみ
　　フォルダ；デスクトップの「Aさん勤務管理」フォルダ
２．添付ファイル名：*勤務管理*　（「勤務管理」を含むファイル名）
　　差出人：Bさんのみ
　　フォルダ；デスクトップの「Bさん勤務管理」フォルダ

　（参考URL　http://q.hatena.ne.jp/1218725545）

このように２つの条件を入れる場合にはどのように記載すれば
良いのでしょうか？
参考URLにあるものを用いて、１つの設定はできるのですが
2つ目の条件（この場合、Bさんの条件）を追加できません！！

本当に初心者なので、ぜひともお力を貸してください！！

回答No.1

yyr446 · ベストアンサー

こうでしょう
For Each mi In mis
Set mai = Application.Session.GetItemFromID(mi)
'★名前で確認
If mai.SenderName = "Aさん" | mai.SenderName = "Bさん" Then
For Each oFile In mai.Attachments
'★ファイル名のチェック
If InStr(oFile.Filename, "勤怠管理") > 0 Then
If mai.SenderName = "Aさん" then
objFile.SaveAsFile "マイドキュメントのパス\Aさん" & "\" & oFile.DisplayName
else
objFile.SaveAsFile "マイドキュメントのパス\Bさん" & "\" & oFile.DisplayName
End If
Next
End If
Next

補足

なるほど！ありがとうございます！

Cさん、Dさんと続く場合には、

For Each mi In mis
Set mai = Application.Session.GetItemFromID(mi)
'★名前で確認
If mai.SenderName = "Aさん" | mai.SenderName = "Bさん"　| mai.SenderName = "Cさん" Then
For Each oFile In mai.Attachments
'★ファイル名のチェック
If InStr(oFile.Filename, "勤怠管理") > 0 Then
If mai.SenderName = "Aさん" then
objFile.SaveAsFile "マイドキュメントのパス\Aさん" & "\" & oFile.DisplayName
else
objFile.SaveAsFile "マイドキュメントのパス\Bさん" & "\" & oFile.DisplayName
else
objFile.SaveAsFile "マイドキュメントのパス\Cさん" & "\" & oFile.DisplayName
End If
Next
End If
Next

となる、という事でしょうか？

回答No.2

winarrow07

あまり詳しくないんで、適当ですが下記のような感じで
できるのでは。AさんBさんのアドレス、Aさん用のフォルダパス、Bさん用のフォルダパスはちゃんとしたものを入れてください。

'-----------------------------------------
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'-----------------------------------------
Dim ns As NameSpace
Set ns = GetNamespace("MAPI")

Dim mf As MAPIFolder
Set mf = ns.Folders("個人用フォルダ").Folders("受信トレイ")

Dim gf As MAPIFolder

Dim mis As Variant
mis = Split(EntryIDCollection, ",")

Dim mai As MailItem
Dim mi As Variant
Dim oFile As Object
　　Dim sAddress As String

For Each mi In mis
Set mai = Application.Session.GetItemFromID(mi)
If mai.SenderEmailAddress = "A-san@foo.bar.ne.jp" or mai.SenderEmailAddress = "B-san@foo.bar.ne.jp" Then
For Each oFile In mai.Attachments
If InStr(oFile.Filename, "勤怠管理") > 0 Then
　　　　　　　　　　sAddress = mai.SenderEmailAddress
saveFile oFile, sAddress
End If
Next
End If
Next
End Sub

'-----------------------------------------
Sub saveFile(objFile As Object, Sender as String)
'-----------------------------------------
　　If Sender = "A-san@foo.bar.ne.jp" Then
　　objFile.SaveAsFile "Aさん用のフォルダパス\" & objFile.DisplayName
　　ElseIf Sender = "B-san@foo.bar.ne.jp" Then
　　　　objFile.SaveAsFile "Bさん用のフォルダパス\" & objFile.DisplayName
　　EndIf

End Sub