[VBA Outlook] Importation de contact - avancéRésolu

Question

Bonjour, 
Voilà mon soucis, je développe une API pour outlook qui permet d'exporter et importer les differents dossier de contact d'outlook, et même chose pour les calendrier.
L'exportation, pas de soucis mais en revanche, je n'arrive pas à importer un contact dans un dossier précis. En effet, toute les sources, exemples et cours que j'ai pu trouver expliquent comment ajouter un contact dans le dossier par défaut.

D'ou ma question :
La commande "ContactItem.save()" sauve le contact dans le defaultFolder. 
Comment puis-je lui spécifier que je veux le sauver dans un dossier de contact annexe ?

merci
bonne vacances à ceux qui en ont

cs_loulou69 · Accepted Answer

Bonjour

Je me suis attaqué à ton problème à la pause de midi. 2 heures de programmation et de test et voilà ! 
Il faut ouvrir un dossier contact existant ou le créer si il n'existe pas.
Ensuite il faut créer un contact dans ce dossier


Sub main()
GetOutlookContacts ("Dossiers personnels\Contacts")
End Sub
Public Function GetOutlookContacts(sLocation As String)

On Error GoTo Hell

Dim objOutlook As Outlook.Application
Dim objFolder As Outlook.MAPIFolder
Dim objAllContacts As Outlook.Items
Dim Contact As Outlook.ContactItem

'For look through the folders
'Dim colFolders As Outlook.Folders

' Set the application object
Set objOutlook = New Outlook.Application

' Set the default Contacts folder
Dim objNamespace As Outlook.NameSpace
Set objNamespace = objOutlook.GetNamespace("MAPI")
'Set objFolder = objNamespace.GetDefaultFolder(olFolderContacts) 'default Contact Folder
'Set objFolder = GetFolder("Personal Folders\Contacts") 'special client
Set objFolder = GetFolder(sLocation) 'special client
'folder (alternate method)

'Make sure the folder was found
If objFolder Is Nothing Then GoTo EXIT_FOR

'Enumerate All contacts in the main MAPI folder
lNumContacts = EnumerateContacts(objFolder)

Set Contact = objOutlook.CreateItem(olContactItem)
Call SetContactInfo(sLocation, Contact, "Toto", "toto@free.fr", "Paris", "Fb St-honore")
Contact.Move objFolder
Contact.Display
'Loop through all of the sub folders of the contacts
'Dim Folder As Outlook.MAPIFolder
'Set colFolders = objFolder.Folders

'Check for valid sub folders
'If colFolders Is Nothing Then GoTo EXIT_FOR

'For Each Folder In colFolders
'Debug.Print Folder.Name
'Get all contacts from this folder
'EnumerateContacts Folder

'Check for child folders
'EnumerateFolders Folder
'Next

EXIT_FOR:
'Cleanup
Set objOutlook = Nothing
Set objFolder = Nothing
Set colFolders = Nothing

Exit Function

Hell:
MsgBox Err.Description & Err.Number
GoTo EXIT_FOR

End Function

Private Function EnumerateFolders(objParentFolder As Object) As Integer

Dim colchildFolders As Outlook.Folders
Dim ChildFolder As Outlook.MAPIFolder

Set colchildFolders = objParentFolder.Folders

If colchildFolders.Count <> 0 Then
For Each ChildFolder In colchildFolders
'Debug.Print ChildFolder.Name
'Attemp to get contacts from folder
EnumerateContacts ChildFolder

'Check for child folders
EnumerateFolders ChildFolder
Next
End If

'Cleanup
Set colchildFolders = Nothing

End Function

Private Function EnumerateContacts(objFolder As Outlook.MAPIFolder) As Long

'Get all contacts for a passed MAPI folder
Dim CountContacts As Long
On Error GoTo Hell

Dim objAllContacts As Outlook.Items
Dim Contact As Outlook.ContactItem

CountContacts = 0
' Set objAllContacts = the collection of all contacts
Set objAllContacts = objFolder.Items

' Loop through each contact
For Each Contact In objAllContacts
Debug.Print objFolder & ": " & Contact.FullName
CountContacts = CountContacts + 1
Next

'Cleanup
Set objAllContacts = Nothing
EnumerateContacts = CountContacts
Exit Function

Hell:

End Function

Private Function GetFolder(strFolderPath As String) As MAPIFolder

' folder path needs to be something like

' "Public Folders\All Public Folders\Company\Sales"

Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim objFolder2 As Outlook.MAPIFolder
Dim arrFolders() As String
Dim i As Long

On Error Resume Next

strFolderPath = Replace(strFolderPath, "/", "")
arrFolders() = Split(strFolderPath, "")

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))

If Not objFolder Is Nothing Then
For i = 1 To UBound(arrFolders)

Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(i))

If objFolder Is Nothing Then
    colFolders.Add arrFolders(i), 10 'olFolderContacts '
    Set objFolder = colFolders.GetLast
    Exit For
End If
Next

End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing

End Function


Sub SetContactInfo(sLocalize As String, oItemContact As Outlook.ContactItem, Optional sName As String, Optional sEmail As String, Optional sAddress As String, Optional sPhone As String)
    With oItemContact
      .FullName = sName
      
      If Not IsNothing(sCompany) Then .CompanyName = sCompany
      If Not IsNothing(sPhone) Then .HomeTelephoneNumber = sPhone
      If Not IsNothing(sEmail) Then .Email1Address = sEmail
      If Not IsNothing(sJob) Then .JobTitle = sJob
      
      If Not IsNothing(sAddress) Then .HomeAddress = sAddress
    End With
'    oItemContact.SaveAs sLocalize & "" & sName, 2 'olContactItem
    oItemContact.Save 'As sLocalize, 2   'olContactItem
End Sub
Public Function IsNothing(oParam) As Boolean
On Error Resume Next
Dim lResult As Boolean

lResult = False
If IsNull(oParam) Then lResult = True
If IsEmpty(oParam) Then lResult = True
If oParam "" Then lResult True
IsNothing = lResult

End Function

jrivet · Answer

Salut,
Et si tu utilise ContactItem.SaveAs(Path As String, [Type]) peu être que cela marcherait (pas teste)

@+, Julien
Pensez: Règlement,Réponse Acceptée, Moteur de recherche

kojak64 · Answer

La seule chose que j'ai pu tiré de cette fonction, c'est l'enregistrement du contact dans un fichier .txt sur mon disque.
Si c'est possible de passer par cette fonction, j'ai pas compris comment...

Peut etre avec le type remarque..., je vais voir
merci

kojak64 · Answer

Nikel, merci beaucoup.
Tu as bossé comme un dingue. Je n'avais pas pensé à la fonction move en effet.
Quand je lance ton module il me sort une erreur "Impossible de déplacer des éléments." lors de l'appel de la fonction move. 
Mais il copie tout de même le contact dans Outlook :s

Il y a quelques retouche a faire mais je vais m'en sortir. 
Encore merci a toi loulou

kojak64 · Answer

Je reviens sur ce que j'ai dit, il me sort l'erreur uniquement quand je laisse "Dossiers personnels\Contacts" comme sLocation, si je met la location d'un dossier secondaire ("Dossiers personnels\Contacts	est" par exemple), no soucis, comme une lettre a la poste. et comme c'est ce cas là qui m'interesse...

merci, code nikel

jessiem34 · Answer

Bonjour,

Je suis intéressé par ce post. Ce n'est pas tout à fait la même chose pour moi. Je crée un mail depuis access avec outlook. Jusque là pas de problème (pièces jointes comprises). Mon souci est de proposer la possibilté d'accéder à la fenêtre "Choisir des noms" (lorsque l'on clique sur le bouton "à..." par exemple, de manière à accéder au carnet d'addresses. Ce qui m'intéresse particulièrement c'est la liste des adresses globale. Il y a tout les groupes du domaine.
Je n'ai peut être pas bien compris la notion de dossier !!!!
QQ1 pourrait me mettre sur la voie.
Je ne veux pas lister les adresses dans une table, juste pour ouvrir cette fenêtre et récupérer la sélection.
Possible d'après vous ?

 jessie M 34

scrapitou · Answer

Moi j'ai utiliser Move de la maniere suivante :

ex : oContact.Save objFolder
où oContact est un objet ContactItem
et objFolder est un objet MAPIFolder qui renseigne le dossier contact en question

voila, j'espere que ca aidera certains

scrapitou · Answer

Desolé erreur de frappe !!! je voulais dire

Moi j'ai utiliser la méthode "Move" de la manière suivante :

ex : oContact.Move objFolder
où oContact est un objet ContactItem
et objFolder est un objet MAPIFolder qui renseigne le dossier contact en question

voila, j'espère que ca aidera certains

[VBA Outlook] Importation de contact - avancé

8 réponses

Votre réponse

Discussions similaires