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"

[Patrick_R]

D'accord, merci du conseil.

[ProgElecT]

Re

En cas d'homonyme (ex : François BERTRAND et Frédéric BERTRAND etc...), ajouter un 2, 3... à l'identifiant de connexion

Je te propose ce

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Dim DicO
 
Function NomIndexer(NomAIndex)
Dim Nindex, NomConstruit
Nindex = 2
Do
    NomConstruit = NomAIndex & "(" & Nindex & ")"
    If DicO.Exists(NomConstruit) = False Then NomIndexer = NomConstruit: Exit Do
    'NomConstruit existant déjà, incrémente le N° index
    Nindex = Nindex + 1
Loop
End Function
 
'-------------------------------------------------------------------------------
Dim SimulTonFichier
Dim T, U
Dim Strline, temp, Nom, Prenom
 
SimulTonFichier = "BERTRAND François" & vbNewLine _
                & "BERNARDO Françis" & vbNewLine _
                & "BERTRAND Frédéric" & vbNewLine _
                & "BERTRAND Luc" & vbNewLine _
                & "BERNARDO Jean" & vbNewLine _
                & "LAMENAS Max" & vbNewLine _
                & "DURANT Eric" & vbNewLine _
                & "LAMENAS Julien" & vbNewLine _
                & "BERTRAND Françoise"
 
Strline = Split(SimulTonFichier, vbNewLine) 'lecture 1er ligne
temp = Split(Strline(0), " ", 2): Nom = temp(0): Prenom = temp(1)
 
Set DicO = CreateObject("Scripting.Dictionary") ' création du tableau type Dictionary
DicO.Add Nom, Prenom '1er ajout du nom et prénom au tableau Dictionary
 
For T = 1 To UBound(Strline) ' équivalence te ta boucle Do Until objFile.AtEndofStream
    temp = Split(Strline(T), " ", 2)
    Nom = temp(0)
    Prenom = temp(1)
    If DicO.Exists(Nom) Then 'un même nom existe déjà dans le tableau Dictionary
        ' appel de la fonction pour indexer le nom
        Nom = NomIndexer(Nom)
    End If
    DicO.Add Nom, Prenom ' ajout du dernier nom/prénom, le nom a peut être été indexé
Next
 
 
'pour vérification
Dim LesNoms, LesPrenoms, MsG
LesNoms = DicO.keys ' récupération des noms
LesPrenoms = DicO.Items ' récupération des prénoms
U = DicO.Count 'Retourne le nombre de paires clés - éléments
For T = 0 To U - 1
    MsG = MsG & LesNoms(T) & " " & LesPrenoms(T) & vbNewLine
Next
MsgBox MsG
 
 
Set DicO = Nothing ' libération explicite de la mémoire

Il va falloir adapter, mais vue que tu as déjà compris la première solution au sujet des accents, je te fais confiance

[Patrick_R]

Cela fonctionne les Nom et Prenom. Cependant je veux que mes utilisateurs puissent se connecter avec la première lettre du prénom. NOM (Ex : François BERTRAND aura F.BERTRAND ; et Frank BERTRAND aura F.BERTRAND2 etc...)

Pour cela, j'ai

Code :

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

1
2
3
osn = SupprAccents(Nom)
oGivenName=SupprAccents(Prenom)
oUname = Left(oGivenName,1) & "." & osn

Je veux donc que mes utilisateurs soit affichés, mais seulement en cas d'homonyme identifiant, des chiffres s'y ajoutent.

[ProgElecT]

.....
Remplacer la ligne 7 par NomConstruit = NomAIndex & Nindex et la ligne 53 par MsG = MsG & left(LesPrenoms(T),1) & "." & LesNoms(T) & vbNewLine.
Donc cela devrait ressembler à ce

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Function NomIndexer(NomAIndex)
Dim Nindex, NomConstruit
Nindex = 2
Do
    NomConstruit = NomAIndex & Nindex
    If DicO.Exists(NomConstruit) = False Then NomIndexer = NomConstruit: Exit Do
    'NomConstruit existant déjà, incrémente le N° index
    Nindex = Nindex + 1
Loop
End Function
 
'-------------------------------------------------------------------------------
Dim SimulTonFichier
Dim T, U
Dim Strline, temp, Nom, Prenom
 
SimulTonFichier = "BERTRAND François" & vbNewLine _
                & "BERNARDO Françis" & vbNewLine _
                & "BERTRAND Frédéric" & vbNewLine _
                & "BERTRAND Luc" & vbNewLine _
                & "BERNARDO Jean" & vbNewLine _
                & "LAMENAS Max" & vbNewLine _
                & "DURANT Eric" & vbNewLine _
                & "LAMENAS Julien" & vbNewLine _
                & "BERTRAND Françoise"
 
Strline = Split(SimulTonFichier, vbNewLine) 'lecture 1er ligne
temp = Split(Strline(0), " ", 2): Nom = temp(0): Prenom = temp(1)
 
Set DicO = CreateObject("Scripting.Dictionary") ' création du tableau type Dictionary
DicO.Add Nom, Prenom '1er ajout du nom et prénom au tableau Dictionary
 
'*********** 1er étape ******************
For T = 1 To UBound(Strline) ' équivalence te ta boucle Do Until objFile.AtEndofStream
    temp = Split(Strline(T), " ", 2)
    Nom = temp(0)
    Prenom = temp(1)
    If DicO.Exists(Nom) Then 'un même nom existe déjà dans le tableau Dictionary
        ' appel de la fonction pour indexer le nom
        Nom = NomIndexer(Nom)
    End If
    DicO.Add Nom, Prenom ' ajout du dernier nom/prénom, le nom a peut être été indexé
Next
' fin de ta boucle Do
 
'************* 2ém étape *****************
Dim LesNoms, LesPrenoms
LesNoms = DicO.keys ' récupération des noms
LesPrenoms = DicO.Items ' récupération des prénoms
U = DicO.Count 'Retourne le nombre de paires clés - éléments
Set DicO = Nothing ' libération explicite de la mémoire
'inscription
For T = 0 To U - 1
    osn = SupprAccents(LesNoms(T))
    oGivenName=left(LesPrenoms(T),1)
    oUname = oGivenName & "." & osn
    'ligne(s) suivante(s) pour ajouter les utilisateurs
Next

[Patrick_R]

.....
Remplacer la ligne 7 par NomConstruit = NomAIndex & Nindex et la ligne 53 par MsG = MsG & left(LesPrenoms(T),1) & "." & LesNoms(T) & vbNewLine.
Donc cela devrait ressembler à ce

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Function NomIndexer(NomAIndex)
Dim Nindex, NomConstruit
Nindex = 2
Do
    NomConstruit = NomAIndex & Nindex
    If DicO.Exists(NomConstruit) = False Then NomIndexer = NomConstruit: Exit Do
    'NomConstruit existant déjà, incrémente le N° index
    Nindex = Nindex + 1
Loop
End Function
 
'-------------------------------------------------------------------------------
Dim SimulTonFichier
Dim T, U
Dim Strline, temp, Nom, Prenom
 
SimulTonFichier = "BERTRAND François" & vbNewLine _
                & "BERNARDO Françis" & vbNewLine _
                & "BERTRAND Frédéric" & vbNewLine _
                & "BERTRAND Luc" & vbNewLine _
                & "BERNARDO Jean" & vbNewLine _
                & "LAMENAS Max" & vbNewLine _
                & "DURANT Eric" & vbNewLine _
                & "LAMENAS Julien" & vbNewLine _
                & "BERTRAND Françoise"
 
Strline = Split(SimulTonFichier, vbNewLine) 'lecture 1er ligne
temp = Split(Strline(0), " ", 2): Nom = temp(0): Prenom = temp(1)
 
Set DicO = CreateObject("Scripting.Dictionary") ' création du tableau type Dictionary
DicO.Add Nom, Prenom '1er ajout du nom et prénom au tableau Dictionary
 
'*********** 1er étape ******************
For T = 1 To UBound(Strline) ' équivalence te ta boucle Do Until objFile.AtEndofStream
    temp = Split(Strline(T), " ", 2)
    Nom = temp(0)
    Prenom = temp(1)
    If DicO.Exists(Nom) Then 'un même nom existe déjà dans le tableau Dictionary
        ' appel de la fonction pour indexer le nom
        Nom = NomIndexer(Nom)
    End If
    DicO.Add Nom, Prenom ' ajout du dernier nom/prénom, le nom a peut être été indexé
Next
' fin de ta boucle Do
 
'************* 2ém étape *****************
Dim LesNoms, LesPrenoms
LesNoms = DicO.keys ' récupération des noms
LesPrenoms = DicO.Items ' récupération des prénoms
U = DicO.Count 'Retourne le nombre de paires clés - éléments
Set DicO = Nothing ' libération explicite de la mémoire
'inscription
For T = 0 To U - 1
    osn = SupprAccents(LesNoms(T))
    oGivenName=left(LesPrenoms(T),1)
    oUname = oGivenName & "." & osn
    'ligne(s) suivante(s) pour ajouter les utilisateurs
Next

Le script devient un vrai bazar . J'étudierai ce code demain, merci beaucoup !

[Patrick_R]

Bonsoir,

Concernant la réponse d'en haut, j'ai fini. Merci beaucoup Prog

J'ai une question, avec ce 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
if StrComp(temp(0), Ucase(temp(0))) = 0 Then 'Compare les 2 mots séparés : Le mot en majuscule va dans Nom
Nom = temp(0)
Prenom= temp(1)
 
else
Nom= temp(1)
Prenom= temp(0)
 
End If
 
osn=Nom
 
oGivenName=Prenom
 
oUname = Left(oGivenName,1) & "." & osn

Comment faire pour que par exemple avec Jean-François NOM, l'identifiant soit JF.NOM et pas J.NOM ?

Merci.

[ProgElecT]

Salut

Une solution parmi d'autres

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
'******************* Ma façon de faire *****************
Private Function FormatPrenom(Mot As String) As String
Dim Tbl() As String, T As Integer
Mot = Replace(Mot, " ", "-")
Tbl = Split(Mot, "-")
If UBound(Tbl) >= 1 Then
    For T = 0 To UBound(Tbl)
        FormatPrenom = FormatPrenom & Left(Tbl(T), 1)
    Next T
    Else
    FormatPrenom = Left(Mot, 1)
End If
End Function
 
Private Sub Command1_Click()
Dim temp(1) As String, Nom As String, Prenom As String, osn As String, oGivenName As String, oUname As String
'pour différant cas de figures
'temp(0) = "François"
'temp(0) = "Jean-François"
'temp(0) = "Jean François"
temp(0) = "Pierres Jean-François"
 
temp(1) = "LENOM"
 
If StrComp(temp(0), UCase(temp(0))) = 0 Then 'Compare les 2 mots séparés : Le mot en majuscule va dans Nom
    Nom = temp(0)
    Prenom = temp(1)
    Else
    Nom = temp(1)
    Prenom = temp(0)
End If
 
osn = Nom
oGivenName = FormatPrenom(Prenom)
'oGivenName = Prenom
 
oUname = oGivenName & "." & osn
Label1.Caption = oUname
End Sub

[Patrick_R]

Bonjour,

Comment faire pour ignorer une (plusieurs) ligne(s) vide(s) du fichier ?
J'ai essayé avec :

Code :

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

1
2
3
4
 
[...]
Do Until objFile.AtEndofStream 
If Len(Trim(StrLine)) > 0 Then

Mais cela ne fonctionne pas.

[ProgElecT]

Salut

Code :

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

1
2
3
4
5
6
7
8
Do Until objFile.AtEndofStream
    Strline = objFile.ReadLine
    If Trim(Strline) <> "" Then
        MsgBox "la ligne contient bien une information"
        Else
        MsgBox "la ligne est vide"
    End If
Loop

[Patrick_R]

Comme avec "Len(Trim etc...)", cela indique que l'objet existe déja en s'arrêtant à la ligne vide (et en ayant ajouté ce qui n'est pas vide)

[ProgElecT]

Vite fait

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Const ForReading = 1, ForWriting = 2
Dim oFso, objFile, Strline
    Set oFso = CreateObject("Scripting.FileSystemObject")
  Set objFile = oFso.OpenTextFile("C:\PersoFrancis\regsvr32UtilisationDe.txt", ForReading)
Do Until objFile.AtEndofStream
    Strline = objFile.ReadLine
    If Trim(Strline) <> "" Then
        MsgBox "la ligne contient bien une information" & vbnewline & Strline
        Else
        MsgBox "la ligne est vide"
    End If
Loop
objFile.Close