Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous les
champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n° tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de téléphone
"bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on supprime
une itération pour ensuite terminer sur l'insertion d'un unique espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " " &
newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous les
champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n° tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de téléphone
"bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on supprime
une itération pour ensuite terminer sur l'insertion d'un unique espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " " &
newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous les
champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n° tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de téléphone
"bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on supprime
une itération pour ensuite terminer sur l'insertion d'un unique espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " " &
newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" <spectre@yahoo.fr> a écrit dans le message de news:
%23JrsICVOGHA.1032@TK2MSFTNGP11.phx.gbl...
Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" <spectre@yahoo.fr> a écrit dans le message de news:
%23JrsICVOGHA.1032@TK2MSFTNGP11.phx.gbl...
Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" a écrit dans le
message de news:Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un
espace _
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2),
0) 'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & "
" & newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & "
" & newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" <laurentf@online.microsoft.com> a écrit dans le
message de news: ee2XgFVOGHA.312@TK2MSFTNGP12.phx.gbl...
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" <spectre@yahoo.fr> a écrit dans le message de news:
%23JrsICVOGHA.1032@TK2MSFTNGP11.phx.gbl...
Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un
espace _
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2),
0) 'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & "
" & newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & "
" & newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" a écrit dans le
message de news:Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un
espace _
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2),
0) 'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & "
" & newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & "
" & newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
--
Spectre
Bonjour,
Effectivement, nous avons un nom de famille qui n'est pas courant... Tu es
originaire de l'est de la France ??
Pour ton problème, voilà l'extrait d'un de mes programmes (VB6) qui fait
exactement la même chose que le tien. Le Save marche très bien. Il apporte
aussi un début de réponse à ton autre question. J'ai séparé la fonction qui
traite la chaine de caractères (fonction Reformat) du reste : en modularisant
de la sorte ton programme, tu peux facilement traiter un grand nombre de
champs. Je n'ai besoin que d'ajouter une ligne pour chaque champ que je veux
traiter.
For Each OneContact In MyContactsFolder.Items
users = users + 1
If users > MaxUsers Then Exit Sub
List1.AddItem "Traitement de " & OneContact.FullName, 0
DoEvents
If Cbx_Numtel.Value = 1 Then
If OneContact.BusinessTelephoneNumber <> "" Then
OneContact.BusinessTelephoneNumber =
Reformat(OneContact.BusinessTelephoneNumber)
If OneContact.BusinessFaxNumber <> "" Then OneContact.BusinessFaxNumber =
Reformat(OneContact.BusinessFaxNumber)
If OneContact.MobileTelephoneNumber <> "" Then
OneContact.MobileTelephoneNumber = Reformat(OneContact.MobileTelephoneNumber)
End If
If cbx_uppercase.Value = 1 Then OneContact.LastName =
UCase(OneContact.LastName)
OneContact.Save
Next OneContact
"Spectre" a écrit dans le message de news:Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" a écrit dans le
message de news:Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
-- Spectre
Bonjour,
Effectivement, nous avons un nom de famille qui n'est pas courant... Tu es
originaire de l'est de la France ??
Pour ton problème, voilà l'extrait d'un de mes programmes (VB6) qui fait
exactement la même chose que le tien. Le Save marche très bien. Il apporte
aussi un début de réponse à ton autre question. J'ai séparé la fonction qui
traite la chaine de caractères (fonction Reformat) du reste : en modularisant
de la sorte ton programme, tu peux facilement traiter un grand nombre de
champs. Je n'ai besoin que d'ajouter une ligne pour chaque champ que je veux
traiter.
For Each OneContact In MyContactsFolder.Items
users = users + 1
If users > MaxUsers Then Exit Sub
List1.AddItem "Traitement de " & OneContact.FullName, 0
DoEvents
If Cbx_Numtel.Value = 1 Then
If OneContact.BusinessTelephoneNumber <> "" Then
OneContact.BusinessTelephoneNumber =
Reformat(OneContact.BusinessTelephoneNumber)
If OneContact.BusinessFaxNumber <> "" Then OneContact.BusinessFaxNumber =
Reformat(OneContact.BusinessFaxNumber)
If OneContact.MobileTelephoneNumber <> "" Then
OneContact.MobileTelephoneNumber = Reformat(OneContact.MobileTelephoneNumber)
End If
If cbx_uppercase.Value = 1 Then OneContact.LastName =
UCase(OneContact.LastName)
OneContact.Save
Next OneContact
"Spectre" <spectre@yahoo.fr> a écrit dans le message de news:
OzvIrbVOGHA.1192@TK2MSFTNGP11.phx.gbl...
Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" <laurentf@online.microsoft.com> a écrit dans le
message de news: ee2XgFVOGHA.312@TK2MSFTNGP12.phx.gbl...
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" <spectre@yahoo.fr> a écrit dans le message de news:
%23JrsICVOGHA.1032@TK2MSFTNGP11.phx.gbl...
Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
-- Spectre
Bonjour,
Effectivement, nous avons un nom de famille qui n'est pas courant... Tu es
originaire de l'est de la France ??
Pour ton problème, voilà l'extrait d'un de mes programmes (VB6) qui fait
exactement la même chose que le tien. Le Save marche très bien. Il apporte
aussi un début de réponse à ton autre question. J'ai séparé la fonction qui
traite la chaine de caractères (fonction Reformat) du reste : en modularisant
de la sorte ton programme, tu peux facilement traiter un grand nombre de
champs. Je n'ai besoin que d'ajouter une ligne pour chaque champ que je veux
traiter.
For Each OneContact In MyContactsFolder.Items
users = users + 1
If users > MaxUsers Then Exit Sub
List1.AddItem "Traitement de " & OneContact.FullName, 0
DoEvents
If Cbx_Numtel.Value = 1 Then
If OneContact.BusinessTelephoneNumber <> "" Then
OneContact.BusinessTelephoneNumber =
Reformat(OneContact.BusinessTelephoneNumber)
If OneContact.BusinessFaxNumber <> "" Then OneContact.BusinessFaxNumber =
Reformat(OneContact.BusinessFaxNumber)
If OneContact.MobileTelephoneNumber <> "" Then
OneContact.MobileTelephoneNumber = Reformat(OneContact.MobileTelephoneNumber)
End If
If cbx_uppercase.Value = 1 Then OneContact.LastName =
UCase(OneContact.LastName)
OneContact.Save
Next OneContact
"Spectre" a écrit dans le message de news:Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" a écrit dans le
message de news:Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter la
ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les numeros
de téléphones saisis dans le champs "n° de téléphone de l'entreprise"
(dans les Contacts) et d'en enlever les caractères "inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n° de
téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être utilisés
dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un espace
_
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours de
traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n° de
tel
nbrIteration = Round(((Len(phoneNbr)) / 2), 0)
'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un numero
de téléphone
cstIntervalle = 0 'initialiation de
la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre de
caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un unique
espace
ReDim Preserve partPhoneNumber(Y + 1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) & " "
& newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & " "
& newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
-- Spectre
Bonjour et merci pour la réponse que je vais exploiter.
Oui, mes grands parents paternels étaient, jecrois, originaires de Metz.
Je sais qu'un membre de la famille a vécu au Japon. Pour ma part, mon père
était diplomate (prénom : Pierre).
Bye
Il se trouve que Laurent Francfort [MS] a formulé :Bonjour,
Effectivement, nous avons un nom de famille qui n'est pas courant... Tu
es originaire de l'est de la France ??
Pour ton problème, voilà l'extrait d'un de mes programmes (VB6) qui fait
exactement la même chose que le tien. Le Save marche très bien. Il
apporte aussi un début de réponse à ton autre question. J'ai séparé la
fonction qui traite la chaine de caractères (fonction Reformat) du reste
: en modularisant de la sorte ton programme, tu peux facilement traiter
un grand nombre de champs. Je n'ai besoin que d'ajouter une ligne pour
chaque champ que je veux traiter.
For Each OneContact In MyContactsFolder.Items
users = users + 1
If users > MaxUsers Then Exit Sub
List1.AddItem "Traitement de " & OneContact.FullName, 0
DoEvents
If Cbx_Numtel.Value = 1 Then
If OneContact.BusinessTelephoneNumber <> "" Then
OneContact.BusinessTelephoneNumber =
Reformat(OneContact.BusinessTelephoneNumber)
If OneContact.BusinessFaxNumber <> "" Then
OneContact.BusinessFaxNumber = Reformat(OneContact.BusinessFaxNumber)
If OneContact.MobileTelephoneNumber <> "" Then
OneContact.MobileTelephoneNumber =
Reformat(OneContact.MobileTelephoneNumber)
End If
If cbx_uppercase.Value = 1 Then OneContact.LastName =
UCase(OneContact.LastName)
OneContact.Save
Next OneContact
"Spectre" a écrit dans le message de news:Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" a écrit dans le
message de news:Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter
la ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les
numeros de téléphones saisis dans le champs "n° de téléphone de
l'entreprise" (dans les Contacts) et d'en enlever les caractères
"inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n°
de téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être
utilisés dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un
espace _
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours
de traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à
remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non
valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n°
de tel
nbrIteration = Round(((Len(phoneNbr)) / 2),
0) 'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un
numero de téléphone
cstIntervalle = 0 'initialiation
de la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre
de caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y +
1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) &
" " & newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un
unique espace
ReDim Preserve partPhoneNumber(Y +
1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) &
" " & newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & "
" & newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
-- Spectre
Bonjour et merci pour la réponse que je vais exploiter.
Oui, mes grands parents paternels étaient, jecrois, originaires de Metz.
Je sais qu'un membre de la famille a vécu au Japon. Pour ma part, mon père
était diplomate (prénom : Pierre).
Bye
Il se trouve que Laurent Francfort [MS] a formulé :
Bonjour,
Effectivement, nous avons un nom de famille qui n'est pas courant... Tu
es originaire de l'est de la France ??
Pour ton problème, voilà l'extrait d'un de mes programmes (VB6) qui fait
exactement la même chose que le tien. Le Save marche très bien. Il
apporte aussi un début de réponse à ton autre question. J'ai séparé la
fonction qui traite la chaine de caractères (fonction Reformat) du reste
: en modularisant de la sorte ton programme, tu peux facilement traiter
un grand nombre de champs. Je n'ai besoin que d'ajouter une ligne pour
chaque champ que je veux traiter.
For Each OneContact In MyContactsFolder.Items
users = users + 1
If users > MaxUsers Then Exit Sub
List1.AddItem "Traitement de " & OneContact.FullName, 0
DoEvents
If Cbx_Numtel.Value = 1 Then
If OneContact.BusinessTelephoneNumber <> "" Then
OneContact.BusinessTelephoneNumber =
Reformat(OneContact.BusinessTelephoneNumber)
If OneContact.BusinessFaxNumber <> "" Then
OneContact.BusinessFaxNumber = Reformat(OneContact.BusinessFaxNumber)
If OneContact.MobileTelephoneNumber <> "" Then
OneContact.MobileTelephoneNumber =
Reformat(OneContact.MobileTelephoneNumber)
End If
If cbx_uppercase.Value = 1 Then OneContact.LastName =
UCase(OneContact.LastName)
OneContact.Save
Next OneContact
"Spectre" <spectre@yahoo.fr> a écrit dans le message de news:
OzvIrbVOGHA.1192@TK2MSFTNGP11.phx.gbl...
Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" <laurentf@online.microsoft.com> a écrit dans le
message de news: ee2XgFVOGHA.312@TK2MSFTNGP12.phx.gbl...
Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter
la ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" <spectre@yahoo.fr> a écrit dans le message de news:
%23JrsICVOGHA.1032@TK2MSFTNGP11.phx.gbl...
Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les
numeros de téléphones saisis dans le champs "n° de téléphone de
l'entreprise" (dans les Contacts) et d'en enlever les caractères
"inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n°
de téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être
utilisés dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un
espace _
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours
de traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à
remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non
valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n°
de tel
nbrIteration = Round(((Len(phoneNbr)) / 2),
0) 'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un
numero de téléphone
cstIntervalle = 0 'initialiation
de la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre
de caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y +
1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) &
" " & newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un
unique espace
ReDim Preserve partPhoneNumber(Y +
1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) &
" " & newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & "
" & newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
-- Spectre
Bonjour et merci pour la réponse que je vais exploiter.
Oui, mes grands parents paternels étaient, jecrois, originaires de Metz.
Je sais qu'un membre de la famille a vécu au Japon. Pour ma part, mon père
était diplomate (prénom : Pierre).
Bye
Il se trouve que Laurent Francfort [MS] a formulé :Bonjour,
Effectivement, nous avons un nom de famille qui n'est pas courant... Tu
es originaire de l'est de la France ??
Pour ton problème, voilà l'extrait d'un de mes programmes (VB6) qui fait
exactement la même chose que le tien. Le Save marche très bien. Il
apporte aussi un début de réponse à ton autre question. J'ai séparé la
fonction qui traite la chaine de caractères (fonction Reformat) du reste
: en modularisant de la sorte ton programme, tu peux facilement traiter
un grand nombre de champs. Je n'ai besoin que d'ajouter une ligne pour
chaque champ que je veux traiter.
For Each OneContact In MyContactsFolder.Items
users = users + 1
If users > MaxUsers Then Exit Sub
List1.AddItem "Traitement de " & OneContact.FullName, 0
DoEvents
If Cbx_Numtel.Value = 1 Then
If OneContact.BusinessTelephoneNumber <> "" Then
OneContact.BusinessTelephoneNumber =
Reformat(OneContact.BusinessTelephoneNumber)
If OneContact.BusinessFaxNumber <> "" Then
OneContact.BusinessFaxNumber = Reformat(OneContact.BusinessFaxNumber)
If OneContact.MobileTelephoneNumber <> "" Then
OneContact.MobileTelephoneNumber =
Reformat(OneContact.MobileTelephoneNumber)
End If
If cbx_uppercase.Value = 1 Then OneContact.LastName =
UCase(OneContact.LastName)
OneContact.Save
Next OneContact
"Spectre" a écrit dans le message de news:Eh, j'ai été un peu vite... ça ne sauvegarde pas.....
"Laurent Francfort [MS]" a écrit dans le
message de news:Bonjour,
C'est l'élement que tu dois sauvegarder, pas le champ. Il faut ajouter
la ligne
olItem.Save
au moment où tu as terminé tes manipulations de chaîne.
Laurent
"Spectre" a écrit dans le message de news:
%Bonjour,
Problème :
j'ai développé un bout de code permettant de mettre en forme les
numeros de téléphones saisis dans le champs "n° de téléphone de
l'entreprise" (dans les Contacts) et d'en enlever les caractères
"inutiles".
Je n'arrive pas à résoudre un dernier problème tout bête : comment
sauvegarder le n° de téléphone sous sa forme "propre" à la place de
l'ancien.
Si également quelqu'un avait une idée pour que la fonction balaye tous
les champs où peut figurer un n° de téléphone, ça serait sympa.
' **********************************
Function Clean_PhoneNbr() ' pour standardiser la présentation des n°
de téléphone _
' cette fonction execute deux opérations _
- suppression de caractres non valides (cad ne pouvant être
utilisés dans un numero) _
- réorganisation des n° par groupe de 2 chivvres séparés par un
espace _
Cette fonction ne traite que les n° professionnels. Pour traiter les
autres n°, il faut modifier l'élément _
BusinessTelephoneNumber sur la ligne : phoneNbr =
olItem.BusinessTelephoneNumber _
Par exemple, pour les n° personnels, saisir
' phoneNbr = olItem.HomeTelephoneNumber
Dim olItem As ContactItem ' contatcts
Dim objContact As MAPIFolder
Dim oSelection
Dim phoneNbr As String ' numero de téléphone du bureau
Dim nbrCharact ' nombre de chiffres dans le numeo
après suppression des espaces
Dim nbrIteration As Integer ' nbre d'itération à réaliser pour
traiter tous les caractères
Dim cstIntervalle As Integer ' intervalle entre 2 séries de 2
chiffres
Dim partPhoneNumber() As String ' partie de phonenumber en cours
de traitement
Dim newPhoneNbr As String ' n° en cours de reconstitution
Dim strNoValid As String ' caractères à supprimer si dans n°
tel
Dim strCaractRemplacer As String 'caractère non valide à
remplacer
Dim I, Y, Z As Integer ' compteurs
cstIntervalle = 2
strNoValid = "/,"" "" );( : - _ "
Set objNS = Application.GetNamespace("MAPI")
Set objContact = objNS.GetDefaultFolder(olFolderContacts)
Set oSelection = objContact.Items
For I = 1 To oSelection.Count
Set olItem = oSelection.Item(I)
xxx = olItem.FullName ' pour repérage durant dvpt
phoneNbr = olItem.BusinessTelephoneNumber ' numero de
téléphone "bureau"
If phoneNbr <> "" Then ' si n° de tel présent
'recherche/remplace les caractères non valides
For Z = 1 To Len(phoneNbr)
strCaractRemplacer = Mid(strNoValid, Z, 1)
phoneNbr = Replace(phoneNbr,
strCaractRemplacer, "") 'supprime les caracteres interdits
Next
' /recherche/remplace les caractères non
valides
Z = 0
nbrCharact = Len(phoneNbr) 'longueur du n°
de tel
nbrIteration = Round(((Len(phoneNbr)) / 2),
0) 'détermine le nombre d'iterations à faire
If nbrIteration <> 0 Then 's il y a un
numero de téléphone
cstIntervalle = 0 'initialiation
de la valeur
If nbrCharact Mod 2 = 0 Then 'si le nombre
de caractères dans le n° est pair
For Y = 1 To nbrIteration
ReDim Preserve partPhoneNumber(Y +
1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) &
" " & newPhoneNbr
Next Y
Else 'nbre de chiffres impair
For Y = 1 To nbrIteration - 1 ' on
supprime une itération pour ensuite terminer sur l'insertion d'un
unique espace
ReDim Preserve partPhoneNumber(Y +
1)
cstIntervalle = cstIntervalle + 2
partPhoneNumber(Y) = Mid(phoneNbr,
(nbrCharact + 1 - cstIntervalle), 2)
newPhoneNbr = partPhoneNumber(Y) &
" " & newPhoneNbr
Next Y
newPhoneNbr = Left(phoneNbr, 1) & "
" & newPhoneNbr ' on introduit un unique espace entre le 1er et 2eme
chiffre
End If
End If
' olItem.BusinessTelephoneNumber =
newPhoneNbr
' LA SAUVEGARDE DEVRAIT SE FAIRE ICI
End If '/si n° de tel présent
phoneNbr = ""
newPhoneNbr = ""
nbrIteration = 0
nbrCharact = 0
strCaractRemplacer = 0
Set olItem = Nothing
Next '/ for I = 1 To oSelection.Count
End Function
Merci d'avance pour votre aide.
-- Spectre