Extraire nom du fichier et chemin dans un dossier vba

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai un code qui va extraire le nom du fichier et le chemin sur une feuille excel, le code est ci-dessous.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub Example1() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim i As Integer 'Create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'Get the folder object Set objFolder = objFSO.GetFolder("C:\Tampon\") i = 1 'loops through each file in the directory and prints their names and path For Each objFile In objFolder.Files 'print file name Cells(i + 1, 1) = Left(objFile.Name, 9) 'print file path Cells(i + 1, 2) = objFile.Path i = i + 1 Next objFile End Sub
En colonne A le nom et colonne B le chemin.

Ce que je souhaite faire pour un nom de fichier, c'est avoir les chemins sur la même ligne et non pas une ligne pour chaque nom.

Comme sur la photo.

Je galère à changer le code pour arriver à mes fins, si vous avez des pistes?

Merci

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Example1()
Dim dict As Object
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
 
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Tampon\")
i = 1
'loops through each file in the directory and prints their names and path
Set dict = CreateObject("Scripting.Dictionary")
For Each objFile In objFolder.Files
 If dict.exists(Left(objFile.Name, 9))= False  Then i = i + 1: dict(Left(objFile.Name, 9)) = i
    'print file name
    Cells(dict(Left(objFile.Name, 9)), 1) = Left(objFile.Name, 9)
    'print file path
    Cells(dict(Left(objFile.Name, 9)), 1).Offset(0, Cells(dict(Left(objFile.Name, 9)), Columns.Count).End(xlToLeft).Column) = objFile.Path
Next objFile
 
End Sub

31/08/2016, 16h09
nonesofar

Parfait,

Ben quand l'expert parle, un code parfait !!

j'y serais pas arrivé tout seul lol.

Merci rdurupt,

Passe en résolu

Personnellement, je trouve qu'il est plus simple de faire appel à la fonction Dir plutôt qu'au FSO.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Example1()
Dim dict As Object
Dim Fich As String
Dim Chemin As String
 
Set dict = CreateObject("Scripting.Dictionary")
Chemin = "C:\Tampon\"
 
Fich = Dir(Chemin)
i = 1
 
'loops through each file in the directory and prints their names and path
While Fich <> ""
   If dict.exists(Left(Fich, 9))= False  Then i = i + 1: dict(Left(Fich, 9)) = i
 
    Cells(dict(Left(Fic, 9)), 1) = Left(Fich, 9)
    Cells(dict(Left(Fich, 9)), 1).Offset(0, Cells(dict(Left(Fich, 9)), Columns.Count).End(xlToLeft).Column) = Chemin & "\" & Fich
 
    Fich = Dir()
WEnd
 
End Sub

31/08/2016, 16h27
nonesofar

Ah merci menhir,

Je ne connais ni l'un ni l'autre mais ça doit être pour ça que j'ai pas bien réussi à modifier mon code.

Le tient semble plus simple en effet :D
31/08/2016, 17h03
nonesofar

Menhir,

J'ai testé ton code mais j'ai une erreur

A la ligne suivante du type 1004, erreur définie par l'application ou par l'objet.

Code:

Cells(dict(Left(Fic, 9)), 1) = Left(Fich, 9)
31/08/2016, 17h36
unparia

Bonjour
Ce que je retiens finalement de la demande est ceci :

Citation:

Ce que je souhaite faire pour un nom de fichier, c'est avoir les chemins sur la même ligne et non pas une ligne pour chaque nom.

Comme sur la photo.

Je suppose que, "comme sur la photo", les données sont triées.
Voir alors cette discussion, qui traite cela :

http://www.developpez.net/forums/d15...e/#post8723356
31/08/2016, 17h59
Invité

Ouvres la fenêtre d'exécution, raccourci clavier [Crtl] + [G]
Écris cela ?Fich et appuis sur la touche [Entrer]

Bien sur tu fais ça quand le message d'erreur apparaît et après avoir cliqué sur debug.
Regardes le résultat et regarde qi il est cohérent avec Left(Fich, 9) car je suis convaincu qu'avec le dir Fich est suffisante a la place du Left(Fich, 9)
01/09/2016, 10h23
nonesofar

Salut à vous,

Alors pour récapituler le 1er code de rdurupt fonctionne bien donc j'ai mon problème qui est solutionné.;)

Juste qu'en essayant le code de menhir pour comprendre les différences de code j'ai eu un message d'erreur,

La manip que tu proposes rdurupt m'indique la même valuer pour ?Fich et Left(Fich, 9).
MAis j'ai pas bien compris la modif de code à effectuer, vu que le bug est toujours la.

Bonjour,
la modification que je propose est

Code:

1
2
3
4
 
 If dict.exists(Fic)= False  Then i = i + 1: dict(Fich) = i
'ETC
 Cells(dict(Fic), 1) = Fich