bancs de testRésolu

Question

Bonjour à tous, J'ai un probleme avec un code excel. J'ai un code, qui permet de se connecter à des bancs de tests et d'en extraire les rapports. Le mot de passe et le login pour se connecter au banc étaient entré en dur dans le code directement. Le probleme que j'ai maintenant, est que ce meme code doit se connecter à plusieurs bancs de test qui n'ont évidemment pas les meme mot de passe et login. Il faudrait donc que je crée deux variables dans une boucle qui viendraient lire les différents mot de passe et login sur une page excel. Mais je n'arive pas à l'insérer dans mon programme initial. Je suis un peu novice et je vous joins un bout de mon programme pour vous faire une idée. Merci à tous. 'Initialisation de la feuile resultat_save ThisWorkbook.Activate Sheets("Résultat_Save").Visible = True Sheets("Résultat_Save").Select Range("A15").End(xlDown).Offset(1, 0).Activate Sheets("Résultat_Save").Visible = xlVeryHidden 'Détermination du nb de bancs et affectation des noms ThisWorkbook.Activate If Not IsEmpty(Range("Banc_N1").Offset(1, 0)) Then Nb_bancs = Range(Range("Banc_N1"), Range("Banc_N1").End(xlDown)).Rows.Count Else: Nb_bancs = 1 End If 'défini l'adresse des bancs. For k = 0 To Nb_bancs - 1 Adresse_Banc(k + 1) = Range("Banc_N1").Offset(k, 0).Value & "" Drive_Banc(k + 1) = "" Next k ListAllDrives 'teste si la connexion existe et remplit drive_banc(x) 'teste les 3 bancs les uns après les autres 'initialisation recherche ThisWorkbook.Activate Sheets("extract").Select Range("A2").Activate Sheets("Résultat").Select Range("A15").End(xlDown).Offset(1, 0).Activate On Error Resume Next Application.ScreenUpdating = False 'sauvegarde et mise à jour barre etat BarreEtatEnregistrée = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Veuillez patienter quelques instants..." 'init var pour savoir si un fichier a été ajouté Test_Si_Fichier_Ouvert = False For N_Banc = 1 To Nb_bancs ' fais le test pour les trois bancs Fisrt_Letter_Free = Left(ListFirstAvailDrive(), 2) If Drive_Banc(N_Banc) = "" Then 'ouvre la session reseau Drive_Disconnect(N_Banc) = True NetR.lpLocalName = Fisrt_Letter_Free ' si non défini se connecte sans device NetR.lpRemoteName = Adresse_Banc(N_Banc) & "d$" Application.StatusBar = "Je me connecte au réseau : Banc numéro : " & Adresse_Banc(N_Banc) ErrInfo = WNetAddConnection2(NetR, Password, Login, CONNECT_UPDATE_PROFILE) If ErrInfo <> NO_ERROR Then CreateObject("wscript.shell").popup "ERROR: " & ErrInfo & " - Connection impossible sur le banc " & Adresse_Banc(N_Banc), 3, "Réseau non connecté" ErrInfo = "" GoTo Fin_Boucle_Banc End If Drive_Letter_Banc(N_Banc) = Fisrt_Letter_Free & "" Else Application.StatusBar = "Je passe au Banc numéro : " & Adresse_Banc(N_Banc) Drive_Letter_Banc(N_Banc) = Drive_Banc(N_Banc) Drive_Disconnect(N_Banc) = False End If Set fs = Application.FileSearch ' definit le chemin de recherche des datas dans le rep mp (crée par chemin extraction) Chemin_Rech = Drive_Letter_Banc(N_Banc) & Range("Banc_N1").Offset(N_Banc - 1, 1).Value With fs .LookIn = Chemin_Rech .Filename = "*.ar" .SearchSubFolders = True If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then CreateObject("wscript.shell").popup "Il y a " & .FoundFiles.Count & " fichiers trouvés.", 2, "Banc :" & Adresse_Banc(N_Banc) ' Début de la boucle pour passer en revue tout les fichiers AR trouvés For i = 1 To .FoundFiles.Count 'Information Pour le status bar et la progression du travail PourcentdAchevement = Fix(i / .FoundFiles.Count * 100) Application.StatusBar = "Je mets en forme les données... j'en suis à " & PourcentdAchevement & " % (soit : " & i & " fichiers traités sur " & .FoundFiles.Count & " fichiers)" 'recherche le chemin du fichier puis extrait le repertoire racine Chemin_En_Cours = Application.FileSearch.FoundFiles.Item(i) file_name = Right(Chemin_En_Cours, Len(Chemin_En_Cours) - InStrRev(Chemin_En_Cours, "")) 'Copie du chemin et du fichier *.xls dans "fichiers_traites" If Left(file_name, 1) = "~" Then GoTo Fin_if ThisWorkbook.Sheets("Fichiers_traités").Range("C1").Value = file_name 'Teste si le fichier existe deja dans la base (a deja été traité) If IsError(ThisWorkbook.Sheets("Fichiers_traités").Range("C4")) Then Fichier_Existe = False Else Fichier_Existe = True End If If Fichier_Existe = False Then Test_Si_Fichier_Ouvert = True 'test pour savoir si 1 seul fichier a été ouvert Err = 0 ' mets la variable d'erreur à zéro Workbooks.Open .FoundFiles.Item(i) If Err = 1004 Then Err = 0 Name_AR_En_Cours = fs.FoundFiles.Item(i) MyPos1 = InStrRev(Name_AR_En_Cours, "") ThisWorkbook.Activate Sheets("Fichiers_traités").Select ActiveCell = Right(Name_AR_En_Cours, Len(Name_AR_En_Cours) - MyPos1) ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Adresse_Banc(N_Banc) & Right(Name_AR_En_Cours, Len(Name_AR_En_Cours) - 3) ActiveCell.Offset(0, 1).Value = "Pb ouverture fichier" ActiveCell.Offset(1, 0).Activate CreateObject("wscript.shell").popup "Fichier : " & Right(Name_AR_En_Cours, Len(Name_AR_En_Cours) - MyPos1) & " non compatible", 2, "ERREUR FICHIER" GoTo Fin_if 'detectes si erreur à l'ouverture et envoi en fin de boucle fichier End If Name_AR_En_Cours = ActiveWorkbook.Name

jrivet · Accepted Answer

Salut,
Pour ne pas avoir a faire des copier coller (ou faire comme dans l'exemple) tu peu très bien faire comme suit( mais je ne sais pas si ca peu t'aller)
Dim NLigne As Long
'pour balayer de A1 à A10
For NLigne = 1 To 10
   Password = Worksheets("LaFeuilleAuMotDepasse").Range("A" & CStr(NLigne)).Text
   Login = Worksheets("LaFeuilleAuMotDepasse").Range("B" & CStr(NLigne)).Text
   ErrInfo = WNetAddConnection2(NetR, Password, Login, CONNECT_UPDATE_PROFILE)
Next, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

jrivet · Answer

Salut,
Et ceci ?

Password = Worksheets("LaFeuilleAuMotDepasse").Range("A1").Text
Login = Worksheets("LaFeuilleAuMotDepasse").Range("B1").Text
ErrInfo = WNetAddConnection2(NetR, Password, Login, CONNECT_UPDATE_PROFILE)

Password = Worksheets("LaFeuilleAuMotDepasse").Range("A2").Text
Login = Worksheets("LaFeuilleAuMotDepasse").Range("B2").Text
ErrInfo = WNetAddConnection2(NetR, Password, Login, CONNECT_UPDATE_PROFILE)
, ----
[code.aspx?ID=41455 By Renfield]

Enuite rien ne t'empeche d'effectuer une boucle sur le numero de ligne
@+: Ju£i?n
Pensez: Réponse acceptée

cs_jackbauer972 · Answer

Tout d'abord merci de ta réponse ultra rapide. 
Un dernier petit truc, qu'entends tu par "faire une boucle autour de la ligne".

Merci encore

cs_jackbauer972 · Answer

Merci beaucoup de ton aide

jrivet · Answer

Salut,
Si cela fonctionne ce sont les post qui t'on aidé à avancer sur lesquels il faut appuyer sur réponse acceptée 

@+: Ju£i?n
Pensez: Réponse acceptée

cs_jackbauer972 · Answer

Desole, c'était une premiere.

Bancs de test

6 réponses

Votre réponse

Discussions similaires