Регистрация входящих сообщений

[Kan-Torog]

Доброго времени суток!
У меня на работе Outlock 2007
Понадобилось регистрировать обращения ко мне. И к каждому обращению присваивать номер. В outlook макросы не писал, но вот что получается:

Public Sub CustomMailMessageRuleADV(Item As Outlook.MailItem)

Dim Mail_Answer As Outlook.MailItem

Dim Number_of_Order As Integer 'переменная для номера заявки

Date_of_Order = Now 'дата

If LCase$(Item.Subject) = "заявка" Then

MsgBox "Поступила заявка от " & Item.SenderEmailAddress ' это можно убрать, если мешает

Set Mail_Answer = CreateItem(olMailItem)

With Mail_Answer
Mail_Answer.To = Item.SenderEmailAddress
Mail_Answer.Body = Item.Body
Mail_Answer.Subject = "RE: Ваша заявка зарегистрирована под № " & Number_of_Order & " от " & Date_of_Order
Mail_Answer.Send

End With
End If

End Sub

У меня проблема заключается в том, что бы Number_of_Order менялся с каждой заявкой на Number_of_Order + 1. Понимаю, что надо привязываться к файлу excel, .txt или реестр. Но как это реализовать не знаю, можете помочь? Желательно к excel. Т.к мыслей по поводу него еще много.
И можете за одно объяснить, как в этот макрос воткнуть правило, что бы письма перемещались в требуемую мне папку. (После Входящих она идет 4ым номером)
Неделю с этим разбираюсь, в этом почти 0, код писал из интернету, выдергивая по крупицам из чужих макросов, что бы не с пустым кодом сюда приходить.

[doober]

А моя проблема в том,что не работаю с Outlook
Написано интуитивно.
Интересно сколько в гору на мизере под тройной в тёмную получил?
Не забудьте создать текстовый файл INI.txt,укажите правильный путь к нему

Public Sub CustomMailMessageRuleADV(Item As Outlook.MailItem)
 Dim myOut As Outlook.Application
 Dim inFolder As Outlook.MAPIFolder
 Dim myNameSpace As Outlook.NameSpace
  Set myoOut = New Outlook.Application
  Set myNameSpace = myoOut.GetNamespace("MAPI")
  Set inFolder = myNameSpace.Folders.Item(4)

Dim Mail_Answer As Outlook.MailItem
Dim Number_of_Order As Integer
Date_of_Order = Date
Open "C:\INI.txt" For Input As #1
Number_of_Order = Val(Input(LOF(1), 1))
Close #1
If LCase$(Item.Subject) = "заявка" Then
Number_of_Order = Number_of_Order + 1
MsgBox "Поступила заявка от " & Item.SenderEmailAddress
Set Mail_Answer = CreateItem(olMailItem)
With Mail_Answer
Mail_Answer.To = Item.SenderEmailAddress
Mail_Answer.Body = Item.Body
Mail_Answer.Subject = "RE: Ваша заявка зарегистрирована под № " & Number_of_Order & " от " & Date_of_Order
Mail_Answer.Send

End With
  Item.Move (inFolder)
   Open "C:\INI.txt" For Output As #1
Print #1, Number_of_Order
Close #1

End If

End Sub

[Kan-Torog]

Спасибо большое! с меня пиво
Слегка подогнал. Ошибся с папкой, решил её пока что исключить. И изменил MsgBox, что бы выдавал имя, так красивее )
В планах менять имя входящего письма, добавляя информацию о заявке. Т.е если идет письмо "Заявка. снятие отчета" Текст шел "RE: Ваша заявка зарегистрирована под № " & Number_of_Order & " от " & Date_of_Order [Снятие отчета]
Ну енто позже.

Public Sub resend(Item As Outlook.MailItem)
 Dim myOut As Outlook.Application
 Dim inFolder As Outlook.MAPIFolder
 Dim myNameSpace As Outlook.NameSpace
  Set myoOut = New Outlook.Application
  Set myNameSpace = myoOut.GetNamespace("MAPI")
  'Set inFolder = myNameSpace.Folders.Item(1).Items()

Dim Mail_Answer As Outlook.MailItem
Dim Number_of_Order As Integer
Dim Date_of_Order
Date_of_Order = Date
Open "C:\INI.txt" For Input As #1
Number_of_Order = Val(Input(LOF(1), 1))
Close #1
If LCase$(Item.Subject) = "заявка" Then
Number_of_Order = Number_of_Order + 1
MsgBox "Поступила заявка от " & Item.SenderName
Set Mail_Answer = CreateItem(olMailItem)
With Mail_Answer
Mail_Answer.To = Item.SenderEmailAddress
Mail_Answer.Body = Item.Body
Mail_Answer.Subject = "RE: Ваша заявка зарегистрирована под № " & Number_of_Order & " от " & Date_of_Order
Mail_Answer.Send

End With
  'Item.Move (inFolder)
   Open "C:\INI.txt" For Output As #1
Print #1, Number_of_Order
Close #1

End If

End Sub