Автосохранение в Outlook

Всем добрый день!
Стоит задача чтобы на отельной машине крутился MS Outlook, принимал письма, сохранял их на жестком диске в текстовом формате и переносил в папку черновик.
Возникла проблема с запуском макроса, вроде бы запускаеться, но не отрабатывает.
Может быть кто-нибудь сталкивался или имееться интерес... Help...
Заранее благодарен
Dim allMail As Outlook.Application

Sub Initialize_handler()
Set allMail = CreateObject("Outlook.application")
MsgBox "Привет, макрос запустился!"
End Sub


Sub allMail_NewMail()

Dim OlApp As Outlook.Application
Dim OlMapi As Outlook.NameSpace
Dim OlFolder As Outlook.MAPIFolder
Dim OlMail As Outlook.MailItem
Dim OlItems As Outlook.Items
Dim OlAtch As Outlook.Attachment
Dim MailFolderName, MailFileName, MailY As String
Dim MailM, MailD, MailH, MailMM, MailS As String

Set OlApp = New Outlook.Application
Set OlMapi = OlApp.GetNamespace("MAPI")
Set OlFolder = OlMapi.GetDefaultFolder(olFolderInbox)
'Set OlFolder = OlMapi.Folders("DailyStatsOutlookUpload")
'Set OlFolder = OlMapi.Folders(1).Folders("DailyStatsOutlookUpload")
Set OlItems = OlFolder.Items
Dim wYear As Integer
'Private Type systemtime
'wYear As Integer
'End Type

MailY = Year(Date)
MailM = Month(Date)
MailD = Day(Date)
MailH = Hour(Time)
MailMM = Minute(Time)
MailS = Second(Time)
MailFileName = MailY & MailM & MailD & "_" & MailH & MailMM & MailS
'MailFileName = datDate
MailFolderName = "d:\temp2\" & MailFileName & ".txt"

For Each OlMail In OlItems
If OlMail.UnRead = True Then
' If LCase(OlMail.Subject) Like "*call center data <^>*" Then
If OlMail.Attachments.Count > 0 Then
For Each OlAtch In OlMail.Attachments
OlAtch.SaveAsFile "d:\temp2\" & OlAtch.FileName
Next OlAtch
With OlMail.Reply
.Body = "Attachment Saved"
.Send
End With
OlMail.Move OlMapi.GetDefaultFolder(olFolderDeletedItems)
'OlMail.Delete
End If
Open MailFolderName For Output Shared As #1
Print #1, OlMail.Body
Close #1
OlMail.Move OlMapi.GetDefaultFolder(olFolderDrafts)
' End If
End If
Next OlMail

End Sub