OVH Cloud OVH Cloud

remplacer ObjFolder.Items(A).FirstName par ObjFolder.Items(A).Nom Dirigeant

21 réponses
Avatar
twinley
Bonjour à tous,

Je prépare le transfert de contacts Outlook avec champs personnalisés,
depuis OL vers XL. Puis une fois la feuille XL complétée à la mimine,
faire le transfert dans l'autre sens, XL vers OL.

J'ai trouvé une sub donnée par Michdenis mais attribuée à un inconnu.
Elle fonctionne pour le sens OL vers XL.
Je ne comprend pas bien les lignes telle la suivante car je ne récupère
pas le nom du champ, mais enfin bref, ça marche. Il suffit de mettre les
entêtes de champs perso dans XL à la main. C'est pas le diable.

.Cells(NumLigne, 2) = ObjFolder.Items(A).FirstName

Si le titre de mon champ comprend un espace, par exemple : Nom Dirigeant
et que je remplace FirstName par Nom Dirigeant, alors j'ai une erreur de
compile.

Ma question : Comment écrire la ligne
.Cells(NumLigne, 2) = ObjFolder.Items(A).Nom Dirigeant
qui plante sous cette forme à cause de l'espace entre nom et dirigeant ?

OL snobe les champs personnalisés et comme j'ai une procédure OL qui va
faire le chemin inverse, je dois aussi modifier la même syntaxe. Là je
suppose que cela doit être vital d'avoir le bon nom de champ :
objItem.Nom Dirigeant à la place de objItem.User1

objItem.UserProperties("Custom1") = objItem.User1

le code :

la sub Michdenis c'est dans le sens OL vers XL
'-------------------------------------
Sub ImporterContacts()
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim ObjFolder As MAPIFolder
Dim NumLigne As Integer
Dim NbContacts As Integer

Set objApp = New Outlook.Application
Set objNS = objApp.GetNamespace("MAPI")
Set ObjFolder = objNS.GetDefaultFolder(olFolderContacts)

NumLigne = 1
NbContacts = ObjFolder.Items.Count

For A = 1 To NbContacts
NumLigne = NumLigne + 1
With Worksheets("Feuil1")
.Cells(NumLigne, 1) = ObjFolder.Items(A)
.Cells(NumLigne, 2) = ObjFolder.Items(A).FirstName
.Cells(NumLigne, 3) = ObjFolder.Items(A).LastName
.Cells(NumLigne, 4) = ObjFolder.Items(A).Email1Address
End With
Next

Set objApp = Nothing: Set objNS = Nothing: Set ObjFolder = Nothing
End Sub
'-------------------------------------

et celle là (http://www.outlookcode.com/d/code/convertfields.htm)
que je n'ai pas encore testé, c'est dans le sens XL vers OL

Sub ConvertFields()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objItems As Items
Dim objItem As Object

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing Then
Set objItems = objFolder.Items
For Each objItem In objItems
' make sure you have a Contact item
If objItem.Class = olContact Then
' convert to your published custom form
objItem.MessageClass = "IPM.Contact.Custom"
' copy data to your custom fields
objItem.UserProperties("Custom1") = objItem.User1
objItem.UserProperties("Custom2") = objItem.User2
objItem.UserProperties("Custom3") = objItem.User3
objItem.UserProperties("Custom4") = objItem.User4
objItem.User1 = ""
objItem.User2 = ""
objItem.User3 = ""
objItem.User4 = ""
objItem.Save
End If
Next
End If

Set objItems = Nothing
Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub


Merci pour votre aide


--
à+twinley

1 réponse

1 2 3
Avatar
twinley
:-D

à+twinley

la belle et scudesque envolée de l'ignoble twinley m'avait échappé, J@@, et
je te remercie de l'avoir ressortie de dessous le tonneau...
et encore merci pour ton soutien face à l'adversité et au Papa Ratzi, comme
dirait christian herbé
jps

"J@@" a écrit dans le message de
news:%

Par solidarité avec jps (effondré de n'avoir pas été choisi, bien qu'il


soit

très benoit), je bois un verre de Beaujolais village en suivant les


messages

!
Il faut savoir soutenir les amis en y mettant les moyens
;-)).
J@@


Belle éclaircie grâce à toi, Michel Pierron, JièL Goubert et ... jps qui
continue ses génuflexions et pendant ce temps on est tranquille.
Pourvou qué ça doure...








1 2 3