Этот макрос Outlook пытается отправить банку электронной почты, созданной сторонним программным обеспечением.Если нужно отфильтровать электронные письма «черного списка» и просто закрыть их, а также «игнорировать перечисленные» электронные письма и ничего не делать с ними (чтобы пользователь мог добавлять заметки и т. Д.)
У меня проблема, так как иногда макрос не 't забрать получателя электронной почты (обычно, если генерируются все электронные письма в другом программном обеспечении), не нажимать на одно из этих писем и просто запускать макрос ... Не поднимая получателя, он не совпадает с черным и игнорируетсписок правильно.
Есть идеи как это исправить?Высоко ценится
Sub BatchSendOutAllOpenEmailsTEST()
Dim objInspectors As Outlook.Inspectors
Dim i As Long
Dim objMail As Outlook.MailItem
Dim lMailCount As Long
Dim arr_Blacklist As Variant, arr_IgnoreList As Variant
Dim str_Blacklist As String, str_IgnoreList As String
Dim Blacklist As Integer, Ignorelist As Integer
'Blacklisted domains emails are closed and not saved
str_Blacklist = "blockemail1.com.au,blockemail2.com.au,blockemail3.com.au"
arr_Blacklist = Split(str_Blacklist, ",")
'IgnoreList domains emails are ignored and email left open
str_IgnoreList = "ignoreemail1.com.au,ignoreemail2.com.au,ignoreemail3.com.au"
arr_IgnoreList = Split(str_IgnoreList, ",")
'Get all open items in your Outlook
Set objInspectors = Outlook.Application.Inspectors
lMailCount = 0
For i = objInspectors.Count To 1 Step -1
If objInspectors.Item(i).CurrentItem.Class = olMail Then
'Get all open emails
Set objMail = objInspectors.Item(i).CurrentItem
'start blacklist checking
Set recip = objMail.Recipients
For Each recip In objMail.Recipients
'str1 = "" ' clear domain variable
Address = recip.Address
lLen = Len(Address) - InStrRev(Address, "@") 'get domains
str1 = Right(Address, lLen)
Debug.Print Address & " - " & str1
'detect emails on blacklist
Blacklist = 0 'clear out blacklist
For b = LBound(arr_Blacklist) To UBound(arr_Blacklist)
Debug.Print "checking: "; str1; " against: "; arr_Blacklist(b)
If arr_Blacklist(b) = str1 Then
Blacklist = Blacklist + 1
End If
Next b
'detect emails on ignorelist
Ignorelist = 0 'clear out Ignorelist
For ig = LBound(arr_IgnoreList) To UBound(arr_IgnoreList)
Debug.Print "checking: "; str1; " against: "; arr_IgnoreList(ig)
If arr_IgnoreList(ig) = str1 Then
Ignorelist = Ignorelist + 1
End If
Next ig
Next
Debug.Print str1; " BL quant: "; Blacklist & " - IG quant: "; Ignorelist
'end blacklist checking
' If objMail.Subject <> "" Then
If objMail.Recipients.Count = 0 Or Blacklist > 0 Then
objMail.Close (olDiscard) 'close email without saving
Debug.Print str1; " closed"
ElseIf Ignorelist = 0 Then
objMail.Send
lMailCount = lMailCount + 1
Debug.Print str1; " Sent"
Else
Debug.Print str1; " Ignored"
End If
' End If
End If
str1 = "" ' clear domain variable
Next
'Prompt you of the results
MsgBox lMailCount & " open emails have been sent out!", vbInformation + vbOKOnly
End Sub