07.12.2006 13:02
OlegON
 
Люди, выручите, заломался уже. Почему-то при приходе спамера, цепляется последнее нормальное письмо и на него генерится автоответ, но и само письмо спамера мувится. Т.е. работают две ветки 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
07.12.2006 13:20
omorozov
 
А что, End if в васике не везде обязателен

Здесь конструкция типа case не лучше подойдет?
07.12.2006 13:30
OlegON
 
Я специально EndIf понавтыкал, чтобы закрыть возможные огрехи и выходы блока условия, как и Goto. А Case тут не пойдет, условия могут быть разные, да и не понятно, зачем менять шило на мыло, если эта простейшая конструкция не работает.
Часовой пояс GMT +3, время: 02:00.

Форум на базе vBulletin®
Copyright © Jelsoft Enterprises Ltd.
В случае заимствования информации гипертекстовая индексируемая ссылка на Форум обязательна.