Discussion :

[Patrick_R]

Bonjour,

Je possède un script permettant d'ajouter rapidement des utilisateurs, référencés dans un fichier, dans un serveur. J'ai pu donc faire le script avec mes bases, et en me renseignant par-ci, par-là. Cependant n'étant pas spécialiste du VBScript, j'aimerais approfondir ce script afin le rendre le plus complet et efficace possible en 3 points :
- Remplacer tous les accents par les lettres sans accents
- En cas d'homonyme (ex : François BERTRAND et Frédéric BERTRAND etc...), ajouter un 2, 3... à l'identifiant de connexion
- Le cas où l'utilisateur se retrouve dans plusieurs Unités d'Organisation.

Pouvez-vous m'aider s.v.p ? Je vous présente mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Do Until objFile.AtEndofStream 
 
Strline=objFile.ReadLine
 
temp = split(Strline," ", 2)
Dim Nom 'as String
Dim Prenom 'as String
 
if StrComp(temp(0), Ucase(temp(0))) = 0 Then
Nom = temp(0)
Prenom= temp(1)
 
else
Nom= temp(1)
Prenom= temp(0)
 
End If
 
 
 
osn=Nom
 
oGivenName=Prenom
 
oUname = Left(oGivenName,1) & "." & osn

Merci d'avance !

[ProgElecT]

Salut, Patrick_R, bienvenue sur DVP

Remplacer tous les accents par les lettres sans accents

Pour cette partie, une fonction de conversion lettres accentuées vers lettres non accentuées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Function RegReplace(Text)
Dim RegularExpressioN, T, U
Dim TblReg, TblSubsit
Dim ListPattern, listSubsit
'création du tableau Pattern
              ListPattern = "À|Á|Â|Ã|Ä|Å Ç È|É|Ê|Ë Ì|Í|Î|Ï Ñ Ò|Ó|Ô|Õ|Ö Ù|Ú|Û|Ü Ý|Ÿ Ž"
ListPattern = ListPattern & " š à|á|â|ã|ä|å ç è|é|ê|ë ì|í|î|ï ñ ð|ò|ó|ô|õ|ö ù|ú|û|ü ý|ÿ"
TblReg = Split(ListPattern, " ", -1, vbTextCompare)
'création du tableau de substitution des lettres accentuées en lettre non accentuée
listSubsit = "A C E I N O U Y Z s a c e i n o u y"
TblSubsit = Split(listSubsit, " ", -1, vbTextCompare)
 
T = UBound(TblReg) - 1
Set RegularExpressioN = New RegExp
RegularExpressioN.Global = True
RegReplace = Text
For U = 0 To T
    RegularExpressioN.Pattern = TblReg(U)
    RegReplace = RegularExpressioN.Replace(RegReplace, TblSubsit(U))   ' Effectue le remplacement
Next
 
Set RegularExpressioN = Nothing
End Function
 
'2 exemples d'utilisation
MsgBox RegReplace("Je possède un script permettant d'ajouter rapidement des utilisateurs, référencés dans un fichier")
MsgBox RegReplace("en me renseignant par-ci, par-là. Cependant n'étant pas spécialiste du VBScript")

[Patrick_R]

C'est parfait ! Merci beaucoup pour cette aide ! Cela fonctionne.

Avec cette fonction, est-il possible également de remplacer les ', - ... par rien du tout ? Par exemple : A'B → AB et C-D → CD ?

[ProgElecT]

Re

Oui en ajoutant ces 2 lignes entre Next et Set RegularExpressioN = Nothing

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
RegularExpressioN.Pattern = "-|'"
RegReplace = RegularExpressioN.Replace(RegReplace, "")

Par contre, avec les 2 exemples proposés, cela n'est pas top

[Patrick_R]

Re

Oui en ajoutant ces 2 lignes entre Next et Set RegularExpressioN = Nothing

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
RegularExpressioN.Pattern = "-|'"
RegReplace = RegularExpressioN.Replace(RegReplace, "")

Par contre, avec les 2 exemples proposés, cela n'est pas top

Super, merci beaucoup ! Il me reste désormais 2 éléments à approfondir

[ProgElecT]

......

Franchement, je séparerais la fonction suppression des accents de ton autre demande (j'ai modifier le nom de la fonction de RegReplace en SuppAccents.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Function SuppAccents(Text)
Dim RegularExpressioN, T, U
Dim TblReg, TblSubsit
Dim ListPattern, listSubsit
'création du tableau Pattern
              ListPattern = "À|Á|Â|Ã|Ä|Å Ç È|É|Ê|Ë Ì|Í|Î|Ï Ñ Ò|Ó|Ô|Õ|Ö Ù|Ú|Û|Ü Ý|Ÿ Ž"
ListPattern = ListPattern & " š à|á|â|ã|ä|å ç è|é|ê|ë ì|í|î|ï ñ ð|ò|ó|ô|õ|ö ù|ú|û|ü ý|ÿ"
TblReg = Split(ListPattern, " ", -1, vbTextCompare)
'création du tableau de substitution des lettres accentuées en lettre non accentuée
listSubsit = "A C E I N O U Y Z s a c e i n o u y"
TblSubsit = Split(listSubsit, " ", -1, vbTextCompare)
 
T = UBound(TblReg) - 1
Set RegularExpressioN = New RegExp
RegularExpressioN.Global = True
SuppAccents = Text
For U = 0 To T
    RegularExpressioN.Pattern = TblReg(U)
    SuppAccents = RegularExpressioN.Replace(SuppAccents, TblSubsit(U))   ' Effectue le remplacement
Next
 
Set RegularExpressioN = Nothing
End Function
 
'2 exemples d'utilisation
dim TextSoumis, TextRetour
 
TextSoumis = "Je possède un script permettant d'ajouter rapidement des utilisateurs, référencés dans un fichier"
TextRetour = SuppAccents(TextSoumis)
MsgBox "Texte soumis:" & vbnewline & TextSoumis & vbnewline & vbnewline _
     & "Texte en retour:" & vbnewline & TextRetour, vbinformations,"sans accents"
 
 
TextSoumis = "en me renseignant par-ci, par-là. Cependant n'étant pas spécialiste du VBScript"
TextRetour = SuppAccents(TextSoumis)
'******** ici la supressions en 2 étapes des tirets et apostrophes avec la fonction native Replace ***********
TextRetour = Replace(TextRetour,"-","")
TextRetour = Replace(TextRetour,"'","")
MsgBox "Texte soumis:" & vbnewline & TextSoumis & vbnewline & vbnewline _
     & "Texte en retour:" & vbnewline & TextRetour, vbinformations,"sans accents ni tirets et apostrophes"