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

Messages postés
6
Date d'inscription
mardi 25 juillet 2006
Dernière intervention
25 juillet 2006
- 25 juil. 2006 à 09:32 - Dernière réponse :
Messages postés
5
Date d'inscription
lundi 23 novembre 2009
Dernière intervention
25 novembre 2009
- 25 nov. 2009 à 17:00
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
Afficher la suite 

Votre réponse

8 réponses

Meilleure réponse
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Dernière intervention
2 juin 2016
- 25 juil. 2006 à 14:32
3
Merci
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

Merci cs_loulou69 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 90 internautes ce mois-ci

Commenter la réponse de cs_loulou69
Meilleure réponse
Messages postés
6
Date d'inscription
mardi 25 juillet 2006
Dernière intervention
25 juillet 2006
- 25 juil. 2006 à 16:32
3
Merci
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\test" par exemple), no soucis, comme une lettre a la poste. et comme c'est ce cas là qui m'interesse...

merci, code nikel

Merci kojak64 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 90 internautes ce mois-ci

Commenter la réponse de kojak64
Messages postés
7401
Date d'inscription
mercredi 23 avril 2003
Dernière intervention
6 avril 2012
- 25 juil. 2006 à 10:19
0
Merci
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
Commenter la réponse de jrivet
Messages postés
6
Date d'inscription
mardi 25 juillet 2006
Dernière intervention
25 juillet 2006
- 25 juil. 2006 à 10:26
0
Merci
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
Commenter la réponse de kojak64
Messages postés
6
Date d'inscription
mardi 25 juillet 2006
Dernière intervention
25 juillet 2006
- 25 juil. 2006 à 16:03
0
Merci
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
Commenter la réponse de kojak64
Messages postés
15
Date d'inscription
mercredi 21 janvier 2004
Dernière intervention
5 février 2008
- 5 févr. 2008 à 18:03
0
Merci
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
Commenter la réponse de jessiem34
Messages postés
5
Date d'inscription
lundi 23 novembre 2009
Dernière intervention
25 novembre 2009
- 25 nov. 2009 à 16:59
0
Merci
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
Commenter la réponse de scrapitou
Messages postés
5
Date d'inscription
lundi 23 novembre 2009
Dernière intervention
25 novembre 2009
- 25 nov. 2009 à 17:00
0
Merci
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
Commenter la réponse de scrapitou

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.