test1

Function MoveTo(psl)
MoveTo = ""
If InStr(psl, "送信者名1") > 0 Then MoveTo = "親フォルダ/子フォルダ/孫フォルダ"
If InStr(psl, "送信者名2") > 0 Then MoveTo = "親フォルダ/子フォルダ/孫フォルダ"
End Function


Sub toFolder()

Set myapp = CreateObject("Outlook.Application")
'受信トレイ
Set i_Folder = myapp.Session.GetDefaultFolder(6)
' 受信トレイの内容を移動
Dim oDest As Outlook.MAPIFolder 'フォルダー

 

'受信トレイを全件処理
For idx = i_Folder.Items.Count To 1 Step -1
On Error GoTo CONTINUE

psl = i_Folder.Items(idx).SentOnBehalfOfName
sbj = i_Folder.Items(idx).Subject

fld = MoveTo(psl)
If fld <> "" Then
If i_Folder.Items(idx).UnRead = False Then
If UBound(Split(fld, "/")) >= 2 Then
f1 = Split(fld, "/")(0)
f2 = Split(fld, "/")(1)
f3 = Split(fld, "/")(2)
Set oDest = Application.Session.Folders("hoge@hoge.co.jp").Folders(f1).Folders(f2).Folders(f3)
i_Folder.Items(idx).Move oDest
ElseIf UBound(Split(fld, "/")) >= 1 Then
f1 = Split(fld, "/")(0)
f2 = Split(fld, "/")(1)
Set oDest = Application.Session.Folders("hoge@hoge.co.jp").Folders(f1).Folders(f2)
i_Folder.Items(idx).Move oDest
Else
f1 = Split(fld, "/")(0)
Set oDest = Application.Session.Folders("hoge@hoge.co.jp").Folders(f1)
i_Folder.Items(idx).Move oDest
End If
End If
End If

CONTINUE:

Next idx


End Sub