Voila mon problème, c'est un script permettant de créer des utilisateurs (ici dans un fichier texte)
j'aimerai pouvoir entrez un utilisateur et ensuite fermer mon script
puis en recréer un qui n'écrase pas celui ke je vien de créer. Voici
mon script:
'===============================================================================
' PROGRAMME DE CREATION D'UN FICHIER D'UTILISATEURS
'===============================================================================
'Oblige la déclaration des variables
Option Explicit
'Déclaration des onstantes
const modeECRITURE = 2
'Décalration des variables globales
Dim fso, f
Dim gLogin, vLogin, vNom, vPrenom
Dim nbSaisies
Dim Retour,Message
'===============================================================================
' DEBUT DU PROGRAMME PRINCIPAL
'===============================================================================
'Ouvrir un fichier (dans le même répertoire que le script s'exécute)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(".\Utilisateurs.txt", modeECRITURE, True)
' True crée le fichier s'il n'existe pas
nbSaisies = 0
'Appel d'une procédure
SaisirVariables vNom, vPrenom
Do While (vNom <> "") And (vPrenom <> "")
gLogin = genLogin(vNom, vPrenom)
If gLogin = "" then
Message = "Impossible de
gnérer automatiquement le login."& vbCrLf & vbCrLf &"Saisir
le login manuellement: "
Else
Message = "Vlaidez le login généré ou proposez-en un autre."
End If
vLogin = InputBox(Message, "Choix du login", gLogin)
If vLogin <> "" then
'Appel d'une focntion
Retour = Enregistrement(vlogin, vNom, vPrenom)
If Retour = "OK" then
nbSaisies = nbSaisies + 1
End if
Else
MsgBox "Login incorrect => Non Enregistré"
End if
'on saisitr un autre couple
SaisirVariables vNom, vPrenom
Loop
MsgBox"Vous avez saisi "& nbSaisies &" utilisateurs correctement."
'Fermer le fichier
f.Close()
Set f = Nothing
Set fso = Nothing
'===============================================================================
' FIN DU PROGRAMME PRINCIPAL
'===============================================================================
'-------------------------------------------------------------------------------
' PROCEDURE DE SAISIE DES VARIABLES
'-------------------------------------------------------------------------------
Sub SaisirVariables(byRef pNom, byRef pPrenom) 'byRef
passage apr référence> en lect./ecr.
'Déclaration des variables locales à la rpocédure
Dim Titre, Msg1, Msg2
Titre = "Demande de renseignement"
Msg1 = "Entrez le nom de l'utilisateur"& vbCrLf &"(vide pour terminer le saisie) : "
Msg2 = "Entrez le prénom de l'utilisateur :"
vNom = inputBox(Msg1, Titre)
If (pNom <> "") then
pPrenom = InputBox(Msg2, Titre)
Else
pPrenom = ""
End If
End Sub
'-------------------------------------------------------------------------------
' FONCTION qui renvoie le RESULTAT d'une tentative d'ENREGISTREMENT
'-------------------------------------------------------------------------------
Function Enregistrement(pLogin, pNom, pPrenom) 'retourne une chaîne de caractère
Dim vLigne
'En cas d'erreur, on tente de continuer
On error resume next
vLigne = pLogin& ":"& pNom &":"&pPrenom
'Instruction critique...
f.WriteLine vLigne
'...donc on test si une erreur s'est produite
If Err.Number = 0 then
'on retourne OK
Enregistrement = "OK"
Else '(en vb, le retour se fait par affectation du nom de la focntion)
MsgBox "Erreur à l'enregistrement"
End if
End Function
'-------------------------------------------------------------------------------
' FONCTION qui GENERE un LOGIN (version simplifée)
'-------------------------------------------------------------------------------
Function genLogin(byVal pnom, byVal ppre) 'retourne une chaîne de caractère
Dim LgNom, LgPre, i, Lg
Dim PremLettre, Lettre, NomOK, Ascii
'conversion en minuscules
pNom = LCase(pnom)
pPre = LCase(ppre)
'Longueur du nom et du prénom
LgNom = Len(pNom)
LgPre = Len(pPre)
'Recupérer la première lettre du prénom
If LgPre > 0 then
PremLettre = Mid(pPre,1,1)
Else
GenLogin = ""
Exit Function
End If
'Nettoyer le nom des espaces et des traits d'union, des lettres accentuées...
i = 1
NomOK = ""
Do While (Lg < 4) And (i<=LgNom)
'tant que je n'ai aps 4 caractères et qu'il en reste
Lettre = Mid(pNom,i,1)
i = i + 1
Ascii = Asc(Lettre)
If (Ascii < 97) Or (Ascii > 122) then 'Ce n'est pas une lettre minuscule
'on vérifie s'il s'agit d'un accent
Select Case Ascii
Case 13, 45,
95 'Espace, Trait d'union,
Soulignement
Lettre = "" 'On les supprime
Case 224, 225, 226, 227, 228 'a avec accent
Lettre = "a"
Case 232, 233, 234, 235 'e avec accent
Lettre = "e"
Case 236, 237, 238, 239 'i avec accent
Lettre = "i"
Case 242, 243, 244, 245, 246 'o avec accent
Lettre = "o"
Case 249, 250, 251, 252 'u avec accent
Lettre = "u"
Case Else 'on ignore les autres lettres
Lettre = ""
End Select
End If
If Lettre <> ""then
nomOK = NomOK & Lettre
Lg = Lg + 1
End if
Loop
GenLogin = PremLettre & NomOK
End Function
