Люди, выручите, заломался уже. Почему-то при приходе спамера, цепляется последнее нормальное письмо и на него генерится автоответ, но и само письмо спамера мувится. Т.е. работают две ветки if, хотя я уж для упрощения их разнес и Goto повтыкал... Хоть какие-то идеи? А то я подтверждениями людей присыпаю, а понять не могу...
Код:
Private Sub Application_NewMail()
Dim oInbox As MAPIFolder
Dim oJunk As MAPIFolder
Dim oItem As MailItem
Dim RItem As MailItem
Dim SItem As MailItem
Dim oAtt As Attachment
Dim WarnAtt As Boolean
On Error GoTo ErrorHandler
WarnAtt = False
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oJunk = Application.Session.GetDefaultFolder(olFolderJunk)
Set oItem = oInbox.Items.GetLast
For Each oAtt In oItem.Attachments
oAtt.SaveAsFile ("C:\TEST\" & oAtt.FileName)
If InStr(LCase(oAtt.FileName), "warning.txt") > 0 Then
WarnAtt = True
End If
Next
oItem.AutoForwarded = False
If InStr(oItem.Subject, "**Disarmed") > 0 Then oItem.AutoForwarded = True
If InStr(oItem.Subject, "**SPAM") > 0 Then oItem.AutoForwarded = True
If InStr(oItem.Subject, "Protected Message System") > 0 Then oItem.AutoForwarded = True
If InStr(oItem.Subject, "Новости AGAVA Software") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@positivethoughts.com") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "funpages.com") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@getresponse.com") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@arcamax.com") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@about.com") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@subscribe.ru") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@funnies.com") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@funthumb.com") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "CYCLE PROFIT-M") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "Read that message attentively") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "direct-mail") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "viagra") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "управленческого учета") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "new videos") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "доставка бесплатно") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "идеальный подарок") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "email рассылки") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "mail server report.") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "message contains unicode characters") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "вниманию руковод") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.Body), "семинар") > 0 Then oItem.AutoForwarded = True
If InStr(LCase(oItem.SenderEmailAddress), "@elexcor.ru") > 0 Then oItem.UnRead = False
If InStr(LCase(oItem.SenderEmailAddress), "@bananamama.ru") > 0 Then oItem.UnRead = False
If InStr(LCase(oItem.Subject), "not from spammer") > 0 Then oItem.AutoForwarded = False
If (LCase(oItem.SenderEmailAddress) = "mr_oa@mail.ru") Then oItem.AutoForwarded = False
If (LCase(oItem.SenderEmailAddress) = "olegon.mai@gmail.com") Then oItem.AutoForwarded = False
If oItem.AutoForwarded Then
oItem.UnRead = False
oItem.Move (oJunk.Folders("Спам"))
GoTo ErrorHandler
End If
If WarnAtt Then
Set RItem = oItem.Reply
RItem.Body = "Добрый день," & Chr(13) & Chr(13) & "Вложение в Ваше письмо было удалено почтовым сервером, как небезопасное. Пожалуйста,заархивируйте его и пришлите заново." & Chr(13) & "Спасибо за понимание." & RItem.Body
RItem.Send
GoTo ErrorHandler
End If
If (LCase(oItem.Recipients.Item(1).Address) = "olegon.mai@gmail.com") Or (LCase(oItem.Recipients.Item(1).Address) = "olego@servplus.ru") Or (LCase(oItem.Recipients.Item(1).Address) = "mr_oa@mail.ru") Or (LCase(oItem.Recipients.Item(1).Address) = "o.kulabukho@servplus.ru") Or (LCase(oItem.Recipients.Item(1).Name) = "кулабухов олег") Then
oItem.Move (oInbox.Folders("Личные"))
GoTo ErrorHandler
End If
If ((LCase(oItem.Recipients.Item(1).Name) = "sm2000@servplus.ru") Or (LCase(oItem.Recipients.Item(1).Name) = "отдел сопровождения см2000")) And (LCase(oItem.SenderEmailAddress) <> "sm2000@servplus.ru") And (InStr(LCase(oItem.SenderEmailAddress), "@servplus.ru") = 0) Then
Set RItem = Application.CreateItem(olMailItem)
If Trim(oItem.SenderName) = "" Then RItem.Recipients.Add ("Анонимный пользователь" & " <" & oItem.SenderEmailAddress & ">") Else RItem.Recipients.Add ("<" & oItem.SenderEmailAddress & ">")
RItem.ReplyRecipients.Add ("sm2000@servplus.ru")
RItem.Subject = "+Reply " + oItem.Subject
RItem.Body = "Добрый день," & Chr(13) & Chr(13) & "Ваше письмо от " & oItem.CreationTime & " было получено нашим отделом и мы постараемся дать на него ответ в течение 24 рабочих часов."
RItem.Body = RItem.Body & Chr(13) & Chr(13) & "Обращаем Ваше внимание, что вся дальнейшая переписка должна вестись только на адрес [email]sm2000@servplus.ru[/email]." & Chr(13) & "Письма на личные адреса не рассматриваются."
RItem.Body = RItem.Body & Chr(13) & Chr(13) & "С уважением, отдел сопровождения ПО" & Chr(13) & "Сервис Плюс АТ"
RItem.Body = RItem.Body & Chr(13) & Chr(13) & "Рекомендуем посетить неофициальный форум и базу знаний пользователей Супермаг2000 и УКМ - https://olegon.ru/" & Chr(13) & "Многие вопросы, задаваемые пользователями, там уже давно разобраны. "
RItem.Send
End If
For Each SItem In Application.Session.GetDefaultFolder(olFolderSentMail).Items
If InStr(SItem.Subject, "+Reply") > 0 Then
SItem.Delete
End If
Next
ErrorHandler:
End Sub