Solved: Save Contact to different folder

[PMHCSLtd]

The following code;

Dim objApp As Outlook.Application

Dim objNewContact As Outlook.ContactItem

Set objApp = CreateObject("Outlook.Application")

Set objNewContact = objApp.CreateItem(olContactItem)

objNewContact.Anniversary = #5/2/1956#
objNewContact.FirstName = "Peter"

objNewContact.Close olSave

creates and saves a new contact to the default Contacts folder. How would I chnage the code so that the contact is saved to the folder 'PMHCS' which is a sub-folder of the Contacts folder? :dunno

Thank you!

Peter H

[matthewspatrick]

Peter,

I think you have to save it to the default folder and then use the Move method. Try something like this:




Dim objApp As Outlook.Application
Dim objNewContact As Outlook.ContactItem
Dim objNameSpace As Outlook.NameSpace
Dim objMAPIFolder As Outlook.MAPIFolder

Set objApp = CreateObject("Outlook.Application")
Set objNewContact = objApp.CreateItem(olContactItem)

With objNewContact
.Anniversary = #5/2/1956#
.FirstName = "Peter"
.Save
Set objNameSpace = objApp.GetNameSpace("MAPI")
Set objMAPIFolder = obj.NameSpace.Folders("PMHCS")
.Move objMAPIFolder
End With



BTW, please use the VBA tags in your posts. It makes it easier to pick up your code.

[PMHCSLtd]

Patrick

Thank you but is this line correct as obj not declared?

Set objMAPIFolder = obj.NameSpace.Folders("PMHCS")

Peter

[matthewspatrick]

Peter,

It is too declared. It might not work, but the variable is declared.

[MOS MASTER]

Hi Peter, :D

No need to move it after you've created it. Just add a new item to the items collection of the folder object.

This should work:
Sub CreateContactToFolder()
Dim olApp As Outlook.Application
Dim objName As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olContact As Outlook.ContactItem
Set olApp = Outlook.Application
Set objName = olApp.GetNamespace("MAPI")
Set olFolder = objName.GetDefaultFolder(olFolderContacts).Folders.Item("PMHCS")
Set olContact = olFolder.Items.Add(olContactItem)

With olContact
.FirstName = "Peter"
.Anniversary = #5/2/1956#
.Close olSave
End With

Set olContact = Nothing
Set olFolder = Nothing
Set objName = Nothing
Set olApp = Nothing
End Sub


HTH. :whistle:

[PMHCSLtd]

Joost

Works fine, thank you.

Peter H

[MOS MASTER]

Hi Peter,
You're welcome! :beerchug: