This code trought Rules wizard.

[Jorge]

Hello, I receive several vcf attachments i want a process that take
this attachment and put it into contacts folder,I have no idea about
VB and macros etc etc, and I have used several example codes in the
forum, well the question is, the macro runs perfect,( maybe the
process is not the better but the final result is what I want) but I
need to insert this code into rules wizard to choose it.
I´ve read in some posts that the method is introducing As mail
item....etc etc.
I don´t know how to do it, if some body could help me

I copy the code(its not mine is a mix of samples in the forums but it
works)
¿Could yo tell me how can I do to insert it into rules wizard?

Thank you.

Sub extract()
Dim oApp As Outlook.Application
Dim myFolder As Outlook.MAPIFolder
Dim myFolderDone As Outlook.MAPIFolder
Dim oFolder As Outlook.MAPIFolder
Dim oMsg As MailItem
Dim oNS As NameSpace
Dim oAttachment As Object
Dim strDate As String
Dim objWSHShell As Object
Dim objOL As Outlook.Application
Dim colInsp As Outlook.Inspectors
Dim strVCName As String

On Error GoTo errhandler

Set oApp = GetObject(, "Outlook.Application") Set oNS =
oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
Set myFolder = oFolder.Folders("temp")
Set myFolderDone = oFolder.Folders("done")
strDate = ""
Set mycontactfolder = oNS.GetDefaultFolder(olFolderContacts)
Set objOL = GetObject(, "Outlook.Application")
Set colInsp = objOL.Inspectors


For Each oMsg In myFolder.Items 'oMsg is an item
With oMsg
If (oMsg.Attachments.Count > 0) Then
For Each oAttachment In oMsg.Attachments
'an attachments or an attachment
With oAttachment
oAttachment.SaveAsFile "C:\temp\" & oAttachment.FileName
strVCName = "C:\temp\" & oAttachment.FileName
If colInsp.Count = 0 Then
Set objWSHShell = CreateObject("WScript.Shell")
objWSHShell.Run strVCName
If Err = 0 Then
Do Until colInsp.Count = 1
DoEvents
Loop
colInsp.Item(1).CurrentItem.Save
colInsp.Item(1).Close olDiscard
End If
End If
End With
Next
oMsg.Move myFolderDone

End If
End With
Next


Exit Sub
errhandler:
MsgBox Err.Description & " and number is " & Err.Number

Set oApp = Nothing
Set oNS = Nothing
Set oFolder = Nothing
Set myFolder = Nothing
Set myFolderDone = Nothing

Set colInsp = Nothing
Set objOL = Nothing
Set objWSHShell = Nothing


Exit Sub
End Sub