Chopper un nom de dossier

[PsykotropyK]

Bon voila, j'ai fait ca pour l'instant

Sub Recherche_Mp3()
On Error Resume Next
Dim Rep As String
Dim i As Long
Dim t As Long
Dim compte As Long
compte = Application.WorksheetFunction.CountA(Sheets('Transfert').Range('A:A'))
For t = 1 To compte
For z = 1 To 2
Sheets('Transfert').Cells(t, z).Value = ''
Next z
Next t
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = 'Choisissez votre répertoire à Scanner'
.Show
Rep = .SelectedItems(1)
End With
Dir
Set fs = Application.FileSearch
With fs
.LookIn = Rep
.SearchSubFolders = True
.Filename = '*.exe'
If .Execute(SortBy:=msoSortByPathName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox 'There were ' & .FoundFiles.Count & ' file(s) found.'
For i = 1 To .FoundFiles.Count
Sheets('Transfert').Cells(i, 1).Value = .FoundFiles(i)
Sheets('Transfert').Cells(i, 2).Value = Dir(.FoundFiles(i), vbDirectory)
Next i
Else
MsgBox 'Pas de fichiers trouvés.'
End If
End With
Sheets('Transfert').Cells(3, 3).Value = CELLULE('nomfichier', A1)

End Sub

En gros pour ceux qui veulent savoir a quoi ca sert, il se passe ca :

- J'ouvre une boite de dialogue invitant a sélectionner un dossier
- Ensuite je scan ce dossier à la recherche de tout les '.exe'
- J'écris en colonne 1 le chemin d'acces complet de chaque fichier
- En colonne 2 le nom du fichier

le but est de mettre en colonne 3 le nom du dossier qui contient le fichier, mais juste le nom, pas le chemin complet... et en colonne 4 le nom du dossier qui contient ce dossier (mais ça c'est moins nécessaire donc vous emm.... pas dessus)

Donc j'ai testé pas mal de truc, j'ai cherché sur le forum (j'y ai trouvé la commande =CELLULE....... mais ca me va pas donc si quelqu'un a une idée... merci.

 

[PsykotropyK]

Au fait, faite pas attention a certaines ligne de code qui servent a rien...

(genre un Dir qui c'est perdu ou une ligne =CELLULE que je n'ai pas effacé)

 

[PsykotropyK]

Je crois j'ai trouvé... merci

 

[PsykotropyK]

A ben non j'ai pas trouvé.

 

[PsykotropyK]

Sinon, serait-il possible de lire caractère apres caractère, d'isoler les '\\' et de ne copier dans des cellules que ce qu'il y a entre ces '\\'...

Comme ca sa serait peut etre plus simple car je pourrait récupérer ce que je veux ensuite et je n'aurait que le nom du dossier et pas son adresse..

Voila... Je vais essayer d'arreter de pourrir mon post avec des posts qui servent a rien maintenant lol

Si des admins peuvent virer les messages qui ne servent a rien (tous sauf le premier et le dernier en gros)

 

[MichelXld]

bonjour

j'espere que cet exemple répondra à ta demande


necessite d'activer la reference Microsoft Scripting RunTime :
dans l'editeur de macros
Menu Outils
References
coches la ligne 'Microsoft Scripting RunTime'
Cliques sur OK pour valider

Option Explicit
Option Compare Text

Dim Chemin As String
Dim x As Integer

Sub requete()
Dim objShell As Object, objFolder As Object
Dim Separateur As Integer

'****
Set objShell = CreateObject('Shell.Application') 'choisir un repertoire cible
Set objFolder = objShell.BrowseForFolder(&H0&, 'Choisir un répertoire', &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = '' Then Chemin = ''
Separateur = InStr(objFolder.Title, ':')
If Separateur > 0 Then Chemin = Mid(objFolder.Title, Separateur - 1, 2) & ''

If Chemin = '' Then Exit Sub
'***

ListFilesInFolder Chemin, True

Chemin = ''
x = 0
End Sub


Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
'
'necessite d'activer la reference Microsoft Scripting RunTime :
'dans l'editeur de macros
'menu Outils
'References
'coches la ligne 'Microsoft Scripting RunTime'
'Clique sur OK pour valider
'
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File

Set Fso = CreateObject('Scripting.FileSystemObject')
Set SourceFolder = Fso.GetFolder(SourceFolderName)


For Each FileItem In SourceFolder.Files
If Right(FileItem, 4) = '.exe' Then

x = x + 1
Cells(x, 1) = FileItem
Cells(x, 2) = FileItem.Name
Cells(x, 3) = SourceFolder.Path
Cells(x, 4) = SourceFolder.ParentFolder.Path
End If
Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.subfolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

End Sub

bonne journée
MichelXld

Message édité par: michelxld, à: 10/11/2005 12:35

 

[PsykotropyK]

Bon alors j'ai trouvé un truc qui me permet effectivement de sortir le nom du dossier (sisi cette fois c'est vrai)...

Donc le code il est ailleur sur le forum mais on va le remettre

Option Explicit
Dim i As Integer
Dim Cible As Byte

'http://support.microsoft.com/newsgroups/newsReader.aspx?dg=microsoft.public.fr.excel&mid=de56386d-8 d0d-4eac-8d1c-ccfbe9c26110
Sub listeDossiersEtSousDossiers()
Dim Racine As String

Application.ScreenUpdating = False

Racine = 'C:\\Documents and Settingsmichel\\excel'
Cible = nbSeparateur(Racine)
ListFilesInFolder Racine, True

Application.ScreenUpdating = True
i = 0
End Sub

Sub ListFilesInFolder(SourceFolderName As String, _
IncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
Dim Fso As Object, SourceFolder As Object
Dim SubFolder As Object

On Error GoTo Fin

Set Fso = CreateObject('Scripting.FileSystemObject')
Set SourceFolder = Fso.GetFolder(SourceFolderName)

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.subfolders



i = i + 1
'pour recuperer le chemin complet
'Cells(i, nbSeparateur(SubFolder.Path) - Cible) = SubFolder.Path
'
'pour recuperer uniquement le nom du dossier
Cells(i, nbSeparateur(SubFolder.Path) - Cible) = SubFolder.Name

ListFilesInFolder SubFolder.Path, IncludeSubfolders
Next SubFolder
End If

Fin:
End Sub


Function nbSeparateur(Chemin As String) As Byte
Dim m As Integer
Dim Nb As Byte

For m = 1 To Len(Chemin)
If Mid(Chemin, m, 1) = '' Then
Nb = Nb + 1
m = m + 1
End If
Next
nbSeparateur = Nb
End Function

(MERCI MICHELXLD)

mais une fois que je chope les nom de mes dossier, il ne les écrit pas... oui mais pka??? (j'ai changé un peu de code, mais seulement les répertoire sur lequel il recherche (avec un msoFileDialogFolderPicker)

Donc quand je fais un pas a pas, il me trouve mon nom de dossier (sans le chemin complet), mais il n'écrit rien... Je pense que la Sub de calcul de la colonne ou il écrit (si j'ai tout compris) marche pas... Ou du moins pas avec moi... Si quelqu'un peut m'aider...

 

[MichelXld]

rebonjour

as tu testé la macro dans mon précédent message (10/11/2005 12:35)


bon apres midi
MichelXld

 

[PsykotropyK]

non désolé j'avais pas vu ton message j'étais en cours quand j'ai tapé... je te dit ca ce soir

 

[PsykotropyK]

Il aime pas trop Scripting en fait...

 

[MichelXld]

bonsoir

as tu suivi la description faite dans le message :

necessite d'activer la reference Microsoft Scripting RunTime :
dans l'editeur de macros
Menu Outils
References
coches la ligne 'Microsoft Scripting RunTime'
Cliques sur OK pour valider


bonne soiree
MichelXld

 

[PsykotropyK]

Bon ca marche sauf que y'a un problème lol...

En gros il ne va que dans le premier répertoire qu'il trouve... en gros, je pense que le problème vient du fait que la boucle entraine l'effacement de :

SubFolder

donc il arrive pour lui forcément au dernier subfolder et il arrete donc la boucle... d'ou le fait qu'il ne scan que dans un seul répertoire...

 

[MichelXld]

bonsoir

je ne comprends pas ta remarque : chez moi tous les sous dossiers sont scannés
tu es sur qu'il y a des fichiers '.exe' dans ces sous dossiers ?


bonne soirée
MichelXld

 

[PsykotropyK]

Ouaip, je test sur mon dossier ou toutes mes appli sont installés...

il commence par Office, il scanne les dossier office, me sort les .exe, et scann pas le reste...

Ensuite il ne test meme pas les autres dossiers : testé en mode pas à pas...

 

[laM]

Bonjour

Si j'ai bien tout compris, vous voulez le détails de ce qu'il y a entre les 'barres obliques inverses'.
Suggestion (testé avec votre premier code)
Dim a as Variant
...
MsgBox 'There were ' & .FoundFiles.Count & ' file(s) found.'
For i = 1 To .FoundFiles.Count
a = Split(.FoundFiles(i), '\\')
Sheets('Feuil1').Cells(i, 1).Value = a(UBound(a)) 'le nom du fichier
Sheets('Feuil1').Cells(i, 2).Value = a(UBound(a) - 1) 'le nom du répertoire contenant le fichier
Sheets('Feuil1').Cells(i, 3).Value = a(UBound(a) - 2) 'le nom du répertoire contenant ce répertoire
Sheets('Feuil1').Cells(i, 4).Value = a(UBound(a) - 3) 'encore un niveau au dess...us/ous
Sheets('Feuil1').Cells(i, 5).Value = Dir(.FoundFiles(i), vbDirectory)
Next i
...

La fonction split découpe une chaîne selon un séparateur '\\' et place les éléments dans un tableau. Son contraire est la fonction join.


Au revoir à bientôt