Ouvrir en boucle fichiers protégés mot de passe

[Benoit]

Bonjour,

J'utilise le code suivant pour faire l'ouverture de fichiers en boucle...

Sub Consolidation()

'Déclaration des variables
Dim varNomFichier
Dim varNomClasseurConso
varNomClasseurConso = Sheets('Menu').Range('C9').Value

Dim CelluleCourante As Range
Dim CelluleSuivante As Range

'Détermine où sera la cellule courante
Set CelluleCourante = Sheets('Fichiers').Range('A1')

'Boucle : Cette boucle s'exécutera tant que la cellule courante ne sera pas vide
Do Until CelluleCourante.Value = ''
varNomFichier = CelluleCourante.Value
Set CelluleSuivante = CelluleCourante.Offset(1, 0)
Workbooks.Open Filename:='C:\\DOSSIERS\\BD Qualité\\' & varNomFichier

'Fermeture du fichier source
Workbooks(varNomFichier).Activate
ActiveWorkbook.Saved = True
ActiveWorkbook.Close

Set CelluleCourante = CelluleSuivante
Loop
Exit Sub
End Sub

Par contre, ces fichiers devront être protégé par mot de passe et c'est là que j'accroche pour gérer la variable 'mot de passe'... Le mot de passe sera différent pour chacun des fichiers mais pourra être indiqué dans le fichier 'consolidé', par exemple dans la feuille 'Fichiers' dans la cellule B de chaque nom de fichier.

Est-ce que qu'une âme charitable a un début de solution ???

 

[Benoit]

J'ai trouvé la solution !

Sub Consolidation()

'Déclaration des variables
Dim varNomFichier
Dim varNomClasseurConso
varNomClasseurConso = 'Classeurwdghlwdghcvklsd.xls'
Dim varPassword

Dim CelluleCourante As Range
Dim CelluleSuivante As Range

'Détermine où sera la cellule courante
Set CelluleCourante = Sheets('Fichiers').Range('A1')

'Boucle : Cette boucle s'exécutera tant que la cellule courante ne sera pas vide
Do Until CelluleCourante.Value = ''
varNomFichier = CelluleCourante.Value
varPassword = CelluleCourante.Offset(0, 1).Value
Set CelluleSuivante = CelluleCourante.Offset(1, 0)
Workbooks.Open Filename:='COSSIERS\\BD Qualité' & varNomFichier, Password:=varPassword


'Fermeture du fichier source
Workbooks(varNomFichier).Activate
ActiveWorkbook.Saved = True
ActiveWorkbook.Close

Set CelluleCourante = CelluleSuivante
Loop
Exit Sub
End Sub

Le forum doit-être une source d'inspiration...

 

[Blunet]

Cool j'allais te proposer la même commande

Ce dont tu avais besoin c'est ctiveWorkbook.Password

Je voulais bien te l'envoyer par fichier ataché mais cette histoire ne m'aime pas. Je zippe les fichiers à - de 50 et ça passe tjrs pas, bref

Public Repertoire As String 'Nom du répertoire
Public NomFichier As String 'Nom du fichier à ouvrir

'Note, il faut au préalabe définir les mots de passe de tous les fichiers
'La commande : ActiveWorkbook.Password = 'mot de passe'

Sub OuvirFichier()
'Boucle
Worksheets('Fichiers').Range('A1', Range('A1').End(xlDown)).Select
Nb = Selection.Count

For i = 1 To Nb
'Récupération
Repertoire = 'C:' ''C:\\RepertoireA\\...\\'
NomFichier = 'DOSSIERSBD Qualité' & Worksheets('Fichiers').Range('A1').Offset(i, 0)
ActiveWorkbook.Password = Worksheets('Fichiers').Range('B1').Offset(i, 0)
' Ouverture
ChDir Repertoire
Workbooks.Open Filename:=NomFichier
Next i
End Sub

'Je te propose une méthode plus courte, plus efficace. Mais ne l'est plus seulement si
'le traitement doit se faire successivement sans l'intervention de l'utilisateur.
'D'ailleurs du moment où le mot de passe doitêtre demandé, l'utilisateur intervient !!
'enfin je crois alors je te propose plustôt la routine OuvrirFichier_2

Sub OuvrirFichier_2()
Dim OuvFich

'Boucle
Worksheets('Fichiers').Range('A1', Range('A1').End(xlDown)).Select
Nb = Selection.Count

For i = 1 To Nb
OuvFich = Application.Dialogs(xlDialogOpen).Show
Next i

'Note, il faut au préalabe définir les mots de passe de tous les fichiers
'La commande : ActiveWorkbook.Password = 'mot de passe'

End Sub

 

[Blunet]

Re:Cool j'allais te proposer la même commande

Fichier joint