VBA, если условие адреса электронной почты отправителя и получателя не работает

Я пишу code для сортировки писем по разным папкам Outlook. Мне нужно задать условие для писем, которые отправляются и принимаются только членами моей компании, но условие с "И" или похожие условия вообще не сортируют письма в папку. Кроме того, использование только условия адреса получателя сортирует письма, которые не содержат только мою компанию в качестве получателя. Буду благодарен за любой совет.

 Sub emailfolder ()
 Dim olApp As Outlook.Application
 Dim objNS As Outlook.NameSpace
 Dim olFolder As Outlook.MAPIFolder
 Dim inmsg As Object

 Set olApp = Outlook.Application
 Set objNS = olApp.GetNamespace("MAPI")
 Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
 Set olMessages = olFolder.Items
 
 Dim recips As Outlook.Recipients
 Dim recip As Outlook.Recipient
 Dim pa As Outlook.PropertyAccessor
 Dim rAddress As String
 Dim sAddress As String

 Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

 Set myDestFolder1 = 
objNS.Folders("[email protected]").Folders("client").Folders("2024").Folders("product").Folders("subproduct")
 
For Each inmsg In olMessages

If TypeOf inmsg Is MailItem Then
Set recips = inmsg.Recipients

For Each recip In recips
Set pa = recip.PropertyAccessor
rAddress = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
sAddress = LCase(SenderEmailAddress)
rLen = Len(rAddress) - InStrRev(rAddress, "@")
sLen = Len(sAddress) - InStrRev(sAddress, "@")
rRight = Right(rAddress, rLen)
sRight = Right(sAddress, sLen)
rLeft = Left(rRight, 3) 'my company uses 2 tld 
sLeft = Left(sRight, 3)

If inmsg.subject Like "*clientx*" Or rRight = "clientx.com" Or sRight = "clientx.com" Then
If rLeft = "mycompany" And sLeft = "mycompany" Then
inmsg.Move myDestFolder1
End If
End If

Next recip
End If
Next inmsg

End Sub
Наркис
Вопрос задан16 августа 2024 г.

1 Ответ

2
Федот
Ответ получен19 сентября 2024 г.

Ваш ответ

Загрузить файл.