Transformer vba code in rule

[Manuel Jr]

I may this vba code to save a mgs in to the drive "c:\temp" and then move the msg to Folder "teste". The problem is this code only work on "ThisOutlookSession" as a makro and i need to put this as script to rule.
Could some help me !
Thank you

"Vba Code"

On Error GoTo Application_NewMail_Error

'Get a reference to the last item in the inbox
Dim olObject As Object
Dim data As Date

Set olObject = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast()

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)

Set myDestFolder = myInbox.Folders("Teste")


'Exit the sub if there is nothing in the inbox. An error will probably be thrown when using the GetFirst method but check anyway
If olObject Is Nothing Then Exit Sub

'Exit the sub if it's not a mail item or appointment item
If Not TypeOf olObject Is Outlook.MailItem And Not TypeOf olObject Is Outlook.AppointmentItem Then Exit Sub

If InStr(olObject.Body, "alterados com efeito às 00:00 horas do dia ") > 0 Then

' Extract the date from the msg

data = Mid(olObject.Body, InStr(olObject.Body, "alterados com efeito às 00:00 horas do dia ") + 43, 10)

'Set the path to your desktop folder here

Const DesktopFolder = "C:\temp\"


olObject.Subject = Replace(olObject.Subject, ":", "")

olObject.SaveAs DesktopFolder & data & ".html", olHTML

'delete the email
'olObject.Delete

'Put the mgs as read

olObject.UnRead = False

'Move the msg to the folder "teste"

olObject.Move myDestFolder


'Set olAttachment = Nothing
Set olObject = Nothing

On Error GoTo 0


Else
End If

Exit Sub



Application_NewMail_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Application_NewMail of VBA Document ThisOutlookSession"

[JP2112]

Does this help?

http://support.microsoft.com/kb/306108

[Manuel Jr]

Tks but i find in internet this site www.mapilab.com/support/. they have good application that solve my problem.
Tks anyway