Обработка всех входящих писем Outlook - VB

<font color="00AA00">' этот исполняемый код</font>
<font color="blue">Sub</font> СохранитьВложения()

<font color="blue">On</font> <font color="blue">Error</font> <font color="blue">Resume</font> <font color="blue">Next</font>
<font color="blue">Dim</font> income(<font color="darkblue"><b>1000</b></font>) <font color="blue">As</font> <font color="blue">String</font>
<font color="blue">Dim</font> FolderName <font color="blue">As</font> <font color="blue">String</font>
<font color="blue">Dim</font> Myf(<font color="darkblue"><b>50</b></font>) <font color="blue">As</font> <font color="blue">String</font>
<font color="blue">Dim</font> data <font color="blue">As</font> <font color="blue">Date</font>
<font color="blue">Dim</font> MonNum <font color="blue">As</font> <font color="blue">String</font>
msg = <font color="darkblue"><b>1</b></font>

<font color="blue">Set</font> myOlApp = CreateObject(<font color="teal">"Outlook.Application"</font>)
<font color="blue">Set</font> myNameSpace = myOlApp.GetNamespace(<font color="teal">"MAPI"</font>)


<font color="00AA00">' Тут идет проверка количества оцениваемых сообщений (бежать по всем входящим нет смысла, долго)</font>
Max = myNameSpace.GetDefaultFolder(olFolderInbox).Items.Count + <font color="darkblue"><b>1</b></font>
<font color="00AA00">' в частности здесь берется 10 последних сообщений</font>
MesBuffer = <font color="darkblue"><b>10</b></font>
<font color="blue">If</font> Max < MesBuffer <font color="blue">Then</font> MesBuffer = Max - <font color="darkblue"><b>1</b></font>
<font color="00AA00">'проверяем больше ли чем 0 сообщений</font>
<font color="blue">If</font> Max > <font color="darkblue"><b>0</b></font> <font color="blue">Then</font>
<font color="00AA00">' цикл по этим сообщениям</font>
<font color="blue">For</font> msg = Max - MesBuffer <font color="blue">To</font> Max
<font color="00AA00">' считаем количство вложений</font>
atcount = myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).Attachments.Count
<font color="00AA00">' смотрим тему</font>
subj = myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).Subject
<font color="00AA00">' вот тут нужно установить бесплатную прогу, которая убирает уведомления на чтение адресов</font>
<font color="00AA00">' расположена http://www.mapilab.com/ru/outlook/security прога бесплатна и для коммерческого и для некоммерческого использования</font>

<font color="00AA00">' смотрим ИФО отправителя</font>
SendName = myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).SenderName
<font color="00AA00">' адрес отправителя</font>
Send = myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).SenderEmailAddress

<font color="00AA00">' Если сообщение имеет статус непрочтеное и вложений не равно 0</font>
<font color="blue">If</font> myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).UnRead = True <font color="blue">And</font> atcount <> <font color="darkblue"><b>0</b></font> <font color="blue">Then</font>
<font color="00AA00">' цикл по всем вложениям</font>
<font color="blue">For</font> I = <font color="darkblue"><b>1</b></font> <font color="blue">To</font> atcount
<font color="00AA00">' наименование вложения</font>
income(msg) = myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).Attachments(<font color="darkblue"><b>1</b></font>)

<font color="00AA00">' тут можно сделать проверку наименования вложения</font>
<font color="00AA00">' проверка</font>

<font color="00AA00">' задаем место хранения (можно в зависимости от наименования вложения назначить путь по условию</font>
pathOL = <font color="teal">"E:\New\"</font>
<font color="00AA00">' Наименование файла вложения Адрес + Тема + НомерСообщения + НомерВложения + НаименованиеВложения (номер сообщения от конца)</font>
MessageName = Send & subj & (Max - msg) & I & income(msg)
<font color="00AA00">' проверяем файл на существование, если он существует в цикле создаем новую версию и ещё раз проверяем</font>
N = <font color="darkblue"><b>0</b></font>
<font color="blue">Do</font> <font color="blue">While</font> Dir(pathOL & MessageName) <> <font color="teal">""</font>
            N = N + <font color="darkblue"><b>1</b></font>
            MessageName = N & Send & subj & (Max - msg) & I & income(msg)
<font color="blue">Loop</font>
<font color="00AA00">' сохраняем вложение</font>
myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).Attachments(<font color="darkblue"><b>1</b></font>).SaveAsFile pathOL & MessageName

<font color="00AA00">'End If</font>
<font color="blue">Next</font> I
<font color="00AA00">' конец файлов непрочитанных со вложениями</font>
<font color="blue">End</font> <font color="blue">If</font>
<font color="00AA00">' помечаем сообщение как прочитанное (любое)</font>
myNameSpace.GetDefaultFolder(olFolderInbox).Items(msg).UnRead = False
<font color="00AA00">'следующее вложение</font>
<font color="blue">Next</font> msg
<font color="00AA00">' очищаем память</font>
<font color="blue">Erase</font> income
<font color="00AA00">' завершаем проверку на количество сообщений больше 0</font>
<font color="blue">End</font> <font color="blue">If</font>

<font color="blue">End</font> <font color="blue">Sub</font>