Extract attachement from Outlook Contacts - vba

Question

I'm wondering if anyone managed to build a code to extract attachements within Outlook contacts? I have a lot of contacts in my outlook 2010 with several attachements and would like to create a copy for backup. Also, if an automated way exist, is it possible to link the downloaded attachement to the contacts?
update
I have used several pieces of code to do what i want but getting a "User-defined type not defined". Anyone know hoe to avoid that error?
Option Explicit
Sub GetAttachments()
Dim ns As Outlook.NameSpace
Dim contactFolder As Outlook.MAPIFolder
Dim myItem As Outlook.Item
Dim ContactItem As Object
Dim Attmt As Outlook.Attachments
Dim FileName As String
Dim i As Integer
Set ns = Application.GetNamespace("MAPI")
Set contactFolder = ns.GetDefaultFolder(olFolderContacts)
Set myItem = contactFolder.Items
Set Attmt = myItem.Attachments
i = 0
' Check each contacts for attachments
For Each ContactItem In contactFolder.Items
' Save any attachments found
For Each Attmt In ContactItem.Attachments
' This path must exist! Change folder name as necessary.
FileName = "C:\Temp\" & Attmt.FileName
Attmt.SaveAsFile FileName
i = i + 1
Next Attmt
Next ContactItem
End Sub

Answer 1

Use ContactItem.Attachments collection. To save an attachment, call Attachment.SaveAsFile.

Answer 2

You can develop a VBA macro or add-in to get the job done. Be aware, VBA macros are not designed for distributing the solution on multiple PCs. See Getting Started with VBA in Outlook 2010 for more information about VBA macros in Outlook.
If you need to automate Outlook from another applications, see How to automate Outlook by using Visual Basic.
As Dmitry suggested, you can use the SaveAsFile method of the Attachment class to save the attached file on the disk.
Sub SaveAttachment()
Dim myInspector As Outlook.Inspector
Dim myItem As Outlook.ContactItem
Dim myAttachments As Outlook.Attachments
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
If TypeName(myInspector.CurrentItem) = "ContactItem" Then
Set myItem = myInspector.CurrentItem
Set myAttachments = myItem.Attachments
'Prompt the user for confirmation
Dim strPrompt As String
strPrompt = "Are you sure you want to save the first attachment in the current item to the Documents folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file."
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & _
myAttachments.Item(1).DisplayName
End If
Else
MsgBox "The item is of the wrong type."
End If
End If
End Sub
To attach a file anew you can use the Add method of the Attachments class which creates a new attachment in the Attachments collection.
Sub AddAttachment()
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = Application.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\Test.doc", _
olByValue, 1, "Test"
myItem.Display
End Sub