Extraire le chemin d'acces d'un fichier

Résolu

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention -
Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention - 4 déc. 2015 à 09:58

Bonjour,

Je dispose d'un dossier contenant plusieurs sous dossiers.
Un code me permet d'extraire le nom des fichiers et de crée un lien d'accès. J'aimerais y ajouter le chemin d'accès complet.
La macro est :

Public ListeDoss() As String

Sub ChercheDoss(Chemin1 As String)
Dim Ligne As Long, Nom As String
Ligne = Range("A65536").End(xlUp).Row + 1
On Error GoTo Err1
Nom = Dir(Chemin1 & "\*" & Range("Texte").Value & "*" & Range("Ext").Value)
If Nom <> "" Then
Cells(Ligne, 1).Value = Nom
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(Ligne, 2), Address:=Chemin1 & "\" & Nom, TextToDisplay:=Nom
Do
Ligne = Range("A65536").End(xlUp).Row + 1
Nom = Dir
If Nom <> "" Then
Cells(Ligne, 1).Value = Nom
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(Ligne, 2), Address:=Chemin1 & "\" & Nom, TextToDisplay:=Nom
End If
Loop Until Nom = ""
End If
Err1:

End Sub

Sub ChercheTout()
Dim Chemin As String, i As Long
Range("A7:C65536").Clear
Chemin = Range("Doss").Value
LanceListe Chemin
For i = 1 To UBound(ListeDoss)
ChercheDoss ListeDoss(i)
Next i
End Sub

Sub ListeArborescence(Dossier As String)
Dim fs, sousdoss
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each sousdoss In fs.getfolder(Dossier).subfolders
ReDim Preserve ListeDoss(1 To UBound(ListeDoss) + 1)
ListeDoss(UBound(ListeDoss)) = sousdoss.Path
ListeArborescence sousdoss.Path
Next sousdoss
On Error GoTo 0
Set fs = Nothing
End Sub

Sub LanceListe(Dossier As String)
ReDim ListeDoss(1 To 1)
ListeDoss(1) = Dossier
ListeArborescence Dossier
End Sub

Pouvez vous m'aider ?

Merci d'avance

A voir également:

Récupérer le chemin d'un fichier vba
Fichier bin - Guide
Comment réduire la taille d'un fichier - Guide
Comment ouvrir un fichier epub ? - Guide
Récupérer au terminal de fret - Forum Consommation & Internet
Fichier rar - Guide

7 réponses

Réponse 1 / 7

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Bonjour,

Un code me permet d'extraire le nom des fichiers et de crée un lien d'accès

je ne vois pas où est le problème, si ton code fait cela le chemin complet est:

Chemin1 & "\" & Nom

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

Bonjour Le Pivert,

Merci de me venir en aide, je n'arrive pas du tout à l'intégrer, j'aimerais que dans la première colonne s'affiche le chemin d'accès complet puis le nom du fichier et les liens d'accès dans la colonne C.
J'ai déjà passé 3heures dessus et n'y arrive pas, je suis un débutant dans le domaine.

Réponse 2 / 7

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Voilà:

If Nom <> "" Then
 Cells(Ligne, 1).Value = Chemin1 & "\" & Nom
Cells(Ligne, 2).Value = Nom 
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(Ligne, 3), Address:=Chemin1 & "\" & Nom, TextToDisplay:=Nom

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

Merci le Pivert,

Ton code marche parfaitement.
J'ai juste un petit souci, la quantité de fichiers .xls dans les sous dossiers varie et le chemin ne s'affiche que pour le premier fichier, pour les suivants c'est le nom qui s'affiche jusqu'au prochain sous dossier.

PS : Si vous êtes de Paris, des cours intéresserait, les capacités de la VBA sont impressionnantes et j'aimerais vraiment approfondir le sujet.

Réponse 3 / 7

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Voilà un exemple, la liste se fait dans un nouveau classeur. Il suffit de l'enregistrer.

http://www.cjoint.com/c/EKunYvPVGxQ

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

C'est pas mal, mais il faut sélectionner le dossier dans lequel on doit faire la recherche.
Alors que dans mon code, la recherche se fait a partir du chemin contenu dans la cellule D2. Et il ne m'extrait que les fichiers au format .xls

La finalité de cet outil est de me faire gagner du temps car les fichiers recherchés s'actualisent tous le temps et aller chercher le dossier principal sur notre serveur serrait un calvaire.

Est'il possible de modifier le code ?

Réponse 4 / 7

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

voilà:

http://www.cjoint.com/c/EKvllyuZh5Q

Bon WE

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

Merci, mais cela crée un nouveau fichier excel, j'ai besoin d'importer d'autres données, il faudrait que ces données s'intègrent dans le fichier de base..

Réponse 5 / 7

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Il faut remplacer l'ajout d'un classeur par celui d'une feuille à la place, comme ceci:

  
 Sub TestListFilesInFolder()
Dim RootFolder$
Dim NouvelleFeuille
  ' dossier à scanner
 'RootFolder = ChoisirDossier
RootFolder = Range("D2").Value
  If RootFolder = "" Then Exit Sub
  
  ' create a new workbook for the file list
 ' Workbooks.Add
 'Worksheets.Add
 Set NouvelleFeuille = Worksheets.Add(Sheets(1))
ActiveSheet.Name = "Liste" 'a adapter

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

Merci le pivert, c'est parfait, j'ai quasiment tous ce dont j'avais besoin.

J'aimerais maintenant récupérer des données grâce à cette liste de chemins\nom de fichier.
Ce code me permet d'extraire ce que je veut mais uniquement à partir du chemin de la macro.
Est'il possible qu'il me parcours la liste de chemins\nom.xls ?


Range("I7").Select 'sélectionner la cellule de début
Chemin = "D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\Devis 001\"
Fichier = Dir(Chemin & "*.xls")
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Set Feuille = ActiveWorkbook.Sheets("MAQUETTE DEVIS")

ThisWorkbook.Activate
ActiveCell.Value = Feuille.Range("C3").Value
ActiveCell.Offset(0, 1).Value = Feuille.Range("A16").Value
ActiveCell.Offset(0, 2).Value = Feuille.Range("A19").Value
ActiveCell.Offset(0, 3).Value = Feuille.Range("E23").Value
ActiveCell.Offset(0, 4).Value = Feuille.Range("E24").Value
ActiveCell.Offset(0, 5).Value = Feuille.Range("E25").Value

Windows(Fichier).Close savechanges:=False
ThisWorkbook.Activate
Range("I65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub

Réponse 6 / 7

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Pour remplacer: Chemin & Fichier par le chemin complet du fichier, il faut parcourir la colonne où se trouve ces fichiers et remplacer le chemin ainsi obtenu par une variable que tu mettrais dans le code que tu nous fait voir.

c'est bien cela que tu veux?

Donc voici un site qui te montre comment parcourir les colonnes ligne par ligne et récupérer ce dont tu as besoin.

C'est pas dans le code que tu nous montres que l'on peut t'aider, a part de remplacer le chemin en dur par une variable.

https://excel.developpez.com/actu/47690/Boucles-pour-parcourir-une-colonne-une-ligne-une-plage-de-donnees-deux-nouvelles-methodes/

Je te signale que je t'ai fourni un classeur où tous les classeurs étaient répertoriés avec le chemin, le nom etc.
Sers t'en!

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

C'est exactement ce que je veux faire, remplacer le Chemin&fichier par la variable se trouvant dans la colonne D = Var Chemin&fichier.
Je suis sur la page que vous m'avez envoyée depuis des heures, mais je n'arrive pas à finaliser le code.
Le code trouve bien le chemin & fichier, mais n'arrive pas à l'ouvrir
Je suis en bonne voie ou totalement à côté de la plaque ?


Sub recup()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
    Set FL1 = Worksheets("Feuil1")
    NoCol = 1 
    For NoLig = 1 To Split(FL1.Range("A7:A6500").Address, "$")(4)
        Var = FL1.Cells(NoLig, NoCol)

Range("I7").Select
Workbooks.Open Filename:=Dir(FL1)
Set Feuille = ActiveWorkbook.Sheets("MAQUETTE DEVIS")


ThisWorkbook.Activate
ActiveCell.Value = Feuille.Range("C3").Value
ActiveCell.Offset(0, 1).Value = Feuille.Range("A16").Value
ActiveCell.Offset(0, 2).Value = Feuille.Range("A19").Value
ActiveCell.Offset(0, 3).Value = Feuille.Range("E23").Value
ActiveCell.Offset(0, 4).Value = Feuille.Range("E24").Value
ActiveCell.Offset(0, 5).Value = Feuille.Range("E25").Value

Windows(Fichier).Close savechanges:=False
ThisWorkbook.Activate
Range("I65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant


Next
End Sub

Réponse 7 / 7

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Tu dis que le chemin est dans la colonne D et dans ton code tu mets colonne 1
Donc voici le code, tu parcours ta colonne D pour avoir ta variable, il faut qu'il y ait le chemin complet avec l'extension!
Tu gardes ta macro et tu remplaces le chemin par ta variable:

Option Explicit
Dim Var As Variant
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
    Set FL1 = Worksheets("Feuil1")
    NoCol = 4 'lecture de la colonne D
    For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
        Var = FL1.Cells(NoLig, NoCol)
        recup
    Next
    Set FL1 = Nothing
End Sub
Sub recup()
'je ne pense pas que cette ligne soit necessaire? A toi de voir
'Range("I7").Select 'sélectionner la cellule de début
Fichier = Var
Do While Fichier <> ""
Workbooks.Open Filename:=Fichier
Set Feuille = ActiveWorkbook.Sheets("MAQUETTE DEVIS")

ThisWorkbook.Activate
ActiveCell.Value = Feuille.Range("C3").Value
ActiveCell.Offset(0, 1).Value = Feuille.Range("A16").Value
ActiveCell.Offset(0, 2).Value = Feuille.Range("A19").Value
ActiveCell.Offset(0, 3).Value = Feuille.Range("E23").Value
ActiveCell.Offset(0, 4).Value = Feuille.Range("E24").Value
ActiveCell.Offset(0, 5).Value = Feuille.Range("E25").Value

Windows(Fichier).Close savechanges:=False
ThisWorkbook.Activate
Range("I65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

Lorsque j'applique cela, il m'affiche variable non définie lorsqu'il lance recup()
et en modifiant le code, il m'ouvre le premier fichier de la liste, extrait les bonnes informations et m'affiche une erreur 9 arrivée a la fermeture du fichier (Windows(Fichier).Close savechanges:=False) :


Sub recup()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
    Set FL1 = Worksheets("Feuil1")
    NoCol = 4
    For NoLig = 7 To Split(FL1.UsedRange.Address, "$")(4)
        Var = FL1.Cells(NoLig, NoCol)


Range("I7").Select
Fichier = Var
Do While Fichier <> ""
Workbooks.Open Filename:=Fichier
Set Feuille = ActiveWorkbook.Sheets("MAQUETTE DEVIS")

ThisWorkbook.Activate
ActiveCell.Value = Feuille.Range("C3").Value
ActiveCell.Offset(0, 1).Value = Feuille.Range("A16").Value
ActiveCell.Offset(0, 2).Value = Feuille.Range("A19").Value
ActiveCell.Offset(0, 3).Value = Feuille.Range("E23").Value
ActiveCell.Offset(0, 4).Value = Feuille.Range("E24").Value
ActiveCell.Offset(0, 5).Value = Feuille.Range("E25").Value

Windows(Fichier).Close savechanges:=False
ThisWorkbook.Activate
Range("I65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant

Loop
Next
End Sub

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729 > Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention

il m'affiche variable non définie

Dans ton code Feuille n'est pas déclarer

ensuite tu n'as pas mis le code que je t'ai donné!

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729 > cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention

Et puis pourquoi mettre cela:

Do While Fichier <> ""
.
.
.
ThisWorkbook.Activate
Range("I65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop

Tu n'as pas a parcourir les fichiers puisque c'est la boucle :

For NoLig = 7 To Split(FL1.UsedRange.Address, "$")(4)

qui le fait

Alors je te souhaite bon courage pour la suite

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

Bonjour,

Lorsque je vous ai écrit "en modifiant le code" cela signifiait que j'avais appliqué le votre avant, cependant dés la troisième ligne votre code bug alors qu’après ma modif j'arrivais à tout extraire, seule la fermeture des fichiers me pose problème.
Malgré mes nombreuses erreurs de codage et mon très bas niveau, je suis tout de même arrivé à mes fins en simplifiant le code.

Je ne cherche pas à me justifier via ce forum, mais plus tôt que l'on m'explique et m'apprenne.

Merci pour le temps que vous avez bien voulu me consacrer.

Nuage75 Messages postés 22 Date d'inscription Statut Membre Dernière intervention 3

j'y suis parvenu, voici le code


Sub recup()

Set f = ThisWorkbook.Sheets("Feuil1")
'parcourir la colonne 4 (à partir de la ligne 7, jusqu'à la dernière cellule non-vide de cette même colonne)
For lig = 7 To f.Cells(Rows.Count, 4).End(xlUp).Row
'ouvrir chaque fichier dont le chemin d'accès et le nom sont renseignés en colonne D
    Workbooks.Open Filename:=f.Cells(lig, 4)
'recopier en colonne F et G de ton fichier (celui contenant la macro), le contenu des cellules A16 et A19, d'une feuille nommée "MAQUETTE DEVIS" dans le ficher qui vient d'être ouvert
    ThisWorkbook.Sheets(1).Cells(lig, 9) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[A16]
    ThisWorkbook.Sheets(1).Cells(lig, 10) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[A19]
    ThisWorkbook.Sheets(1).Cells(lig, 11) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[E23]
    ThisWorkbook.Sheets(1).Cells(lig, 12) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[E24]
    ThisWorkbook.Sheets(1).Cells(lig, 13) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[E25]
'refermer le fichier (celui dont le nom figure en colonne D)
    ActiveWorkbook.Close savechanges:=False
Next lig
End Sub

Discussions similaires

Masquer des lignes en fonction de la valeur d'une cellule

copier coller une plage de cellules dans une autre feuille

renommer des fichiers en VBA

Sélection jusqu'à la prochaine cellule non vide

Copie jusqu'à dernière ligne remplie

Choisir plage jusqu'à la dernière cellule contenant une valeur

Votre réponse

Discussions similaires