problem creat contact

[fbe92]

Hello everyone,

I ask for your because I have a problem that I can not solve, thank you in advance for your help.
Here I want via VBA to create a contact but not in the default directory that is "Contacts" but in the "Shared Contacts" group in my "test" subdirectory.
I have a code (below) which adds the contact in the default directory "Contacts" but I do not know how to modify this code so that the contact is added to the "test" directory of the group "Shared contacts" .
How to modify this code to arrive at the desired result?
Thank you.

[fbe92]

code.JPG

[gmayor]

Are you trying to run this macro from Outlook? If so then you need some changes. Basically the code prompts for the target folder, then creates the entry in the default folder from which it is moved to the previously selected folder.

Sub AddContact()
Dim objContact As ContactItem
Dim objFolder As Folder
    Set objFolder = Session.PickFolder
    Set objContact = CreateItem(olContactItem)
    With objContact
        .FullName = "AAA"
        .Email1Address = "kenmyer@fabrikam.com"
        .CompanyName = "Fabrikam"
        .JobTitle = "Administrateur reseau"
        .HomeTelephoneNumber = "555-555-8888"
        .HomeAddress = "3725 205th NE" & vbCrLf & "Redmond, wa 98052"
        .Birthday = "9/15/1966"
        .Save
        .Move objFolder
    End With
lbl_Exit:
    Set objContact = Nothing
    Set objFolder = Nothing
    Exit Sub
End Sub

If you are trying to run it from another Office application then it needs some further changes

Option Explicit

Sub AddContact()
Dim objOutlook As Object
Dim objContact As Object
Dim objFolder As Object
Const olContactItem As Long = 2
    Set objOutlook = CreateObject("Outlook.Application")
    Set objFolder = objOutlook.Session.PickFolder
    Set objContact = objOutlook.CreateItem(olContactItem)
    With objContact
        .FullName = "AAA"
        .Email1Address = "kenmyer@fabrikam.com"
        .CompanyName = "Fabrikam"
        .JobTitle = "Administrateur reseau"
        .HomeTelephoneNumber = "555-555-8888"
        .HomeAddress = "3725 205th NE" & vbCrLf & "Redmond, wa 98052"
        .Birthday = "9/15/1966"
        .Save
        .Move objFolder
    End With
lbl_Exit:
    Set objOutlook = Nothing
    Set objFolder = Nothing
    Set objContact = Nothing
    Exit Sub
End Sub

[fbe92]

Hello gmayor

It works fine but how do I make the contact saved in my "test" folder directly without going through the select menu?
Thank you.

[fbe92]

How to make my code below work well under Outlook, also works well in Excel?
Thank you for your help.

code.JPG

[burgDD]

You have to create the item from the application itself (i.e. your runoutlook Outlook Object) and then move it to the desired folder.