How to save contact attachments into contact folder?

[dylankhoolim]

I am trying to save a contact which is attached in an email into my contact folder using vba. I wrote the following code but it doesn't seem to work. Can anyone help? Thank you

Sub savecontatt()
'save contact attachments into contact folder
'declare
Dim del As Boolean
'initialize
Set Inbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set Contacts = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
On Error Resume Next

'start
For Each Item In Inbox.Items
'get attachments and save into contacts folder
For Each atmt In Item.Attachments
With atmt
nm = .FileName
nm2 = Right(nm, 4)
If nm2 = ".msg" Then
.Save Contacts
del = True
End If
End With
Next atmt
'delete message
If del = True Then
With Item
.Close
.Delete
End With
del = False
End If

Next
End Sub

[westconn1]

try like


fn = "c:\temp\citem.msg" 'change to suit, each will overwrite, delete after loop if required
For Each atmt In item.Attachments
With atmt
nm = .FileName
nm2 = Right(nm, 4)
If nm2 = ".msg" Then
.SaveAsFile fn
Set newcontact = Application.CreateItemFromTemplate(fn)
'newcontact.Display
newcontact.Save
del = True
End If
End With
Next atmt

[dylankhoolim]

Works perfectly. Many thanks Mark.