Chemin d'accès dossier par nom dans cellule [XL-2010]

Salut Youni,

Loool, ça c'est du roman ! Et je crois que tu ne t'y es pas bien pris pour le pas à pas. Il faut répéter la touche F8 pour passer chaque ligne, c'est l'utilisateur qui contrôle l'exécution et qui peut donc s'arrêter à tout moment (d'où les "blocages" que tu rencontrais ).

Oui, ça peut être très lourd de boucler sur tous les dossiers donc il vaut mieux cibler au départ le dossier parent le plus éloigné de la racine pour optimiser l'exécution.

C'est une bonne chose à savoir que le code ne fonctionne pas à partir du lecteur. Je n'ai toujours pas fait d'essais mais j'en ferai un jour pour tenter de trouver un moyen d'y parvenir.

En tout cas, je suis très content que ça fonctionne !

Petite info de dernière minute : le code n'arrive pas à trouver le dossier sur le lecteur S:\ (même si l'on parle d'un dossier se trouvant sur la racine).

3GB je note ton enthousiasme, mais j'ai encore besoin de toi !

Comment je vais chercher dans l’intégralité d'un dossier cible ? Est-ce que je peux avoir une boite de dialogue qui me permet de choisir le dossier de recherche ? Pour éviter de chercher dans TOUS les sous dossier présents dans le lecteur S:\ notamment...

Si ça marche sur le lecteur K, il n'y a pas de raison que ça ne marche pas sur le S, à moins qu'il y ait une sécurité particulière...

Il faut vraiment que les dossiers contiennent exactement le mot-clé car la fonction respecte la casse.

Peux-tu essayer en modifiant cette ligne :

If ucase(osubfolder.Name) Like "*" & ucase(MotCle) & "*" Then dico(osubfolder.Path) = ""

Il faut que j'arrête de répondre avant que tu réponde

Et bien, l'idéal serait d'avoir les répertoires cibles inscrits en dur dans le code mais cela suggère qu'ils soient toujours les mêmes !

Sinon, en effet, tu peux recourir à une boite de dialogue de sélection de dossier. scraper a laissé un code qui permet de sélectionner un dossier je crois.

En tout cas, le code sera à adapter...

J'ai tester ce que tu m'as demandé, sur ton code [celui du module 1].

Après un temps d'attente certain, l'erreur 76 est remonté sur la ligne et je n'ai aucun retour que ce soit sur des dossier racine ou enfant du K ou du S

For Each osubfolder In ofolder.subfolders

Concernant le fichier du dossier de recherche, que ce soit une boite de dialogue ou quelque chose à inscrire directement dans le code me va.

J'ai effectivement tester la solution de scraper et bien quel me permette de choisir un dossier dans une boite de dialogue, je ne sais pas du tout ou intégrer cette fonctionnalité dans le code du module 2 (car celui du 1 ne ressort aucun chemin d'accès, même sur le cas du changement que tu viens de me demander).

J'ai téléchargé et essayer de comprendre et le chemin pour finir ton projet n'est pas simple

Je ne pense pas qu'activer "Microsoft Scripting Runtime" t'a apporté grand chose.

Je ne comprend pas dans FileSearch

With ActiveSheet.Cells(2, 3)

je mettrai bien dans la feuille Feuil1 la routine Worksheet_SelectionChange ci-dessous

Private Sub Worksheet_SelectionChange(Byval Target As Range)
ON error Resume next
Range("K1").Value= ActiveCell.Range
End Sub

Je ne comprends pas
If odrive.driveletter Like "[KS]" Then
remplacez la boucle For ci-après parce que rechercher sur tous les disques en même temps me semble assez osé
For Each odrive In fso.drives
If odrive.driveletter Like "[KS]" Then
srep$ = odrive.rootfolder.Path
Parcourir srep, .Value
End If
Next odrive

par le code ci-après où la colonne 11 est la colonne K

With ActiveSheet.Cells(1,11)
sRep=SelectionnerDossier
Parcourir srep,.Value
End With

On ne peut pas garder deux modules qui contiennent les mêmes procédures, car lorsque l'on active la compilation : menu "Débogage", "Compiler VBA Project" , VBE doit remonter une erreur

Voilà une semaine que je suis inscrit sur le site, et je me pose les questions qui feront que je saurai mieux venir en aide par la suite. Désolé si je ne suis pas encore au top, j'apprends aussi sur un autre registre

Je viens de faire un essai sur le lecteur C. Après 2 bonnes minutes d'exécution, j'ai un retour sans erreur (j'avais rencontré des erreurs 70 mais aucune erreur 76) :

Public dico As Object

Sub Filesearch()
Set fso = CreateObject("Scripting.filesystemobject")
Set dico = CreateObject("Scripting.dictionary")
With ActiveSheet.Cells(2, 1) '<<< ADAPTER : CELLULE CONTENANT MOT CLE
    For Each odrive In fso.drives
        If odrive.driveletter Like "[KS]" Then
            srep$ = odrive.rootfolder.Path
            Parcourir srep, .Value
        End If
    Next odrive
    With .Offset(, 1)
        .Resize(.End(xlDown).Row - .Row + 1).ClearContents
        If dico.Count > 0 Then .Resize(dico.Count) = Application.Transpose(dico.keys)
    End With
End With
Set dico = Nothing
End Sub

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
Set ofolder = fso.getfolder(spath)
On Error Resume Next
nb = ofolder.subfolders.Count
On Error GoTo 0
If nb > 0 Then
    For Each osubfolder In ofolder.subfolders
       If osubfolder.Attributes <= 48 Then
           If UCase(osubfolder.Name) Like "*" & UCase(MotCle) & "*" Then dico(osubfolder.Path) = ""
           Parcourir osubfolder.Path, MotCle
        End If
    Next osubfolder
End If
End Function

C'est juste pour mettre une version à jour et voir ton retour (concernant ces erreurs 76 notamment). Mais il y aura lieu de modifier de toute façon pour partir d'un dossier cible et non du lecteur.

Salut scraper,

Le bloc with fixe l'objet de la feuille au centre de la procédure :

- on en demande la valeur,

- avec la cellule à côté : on efface les données de la zone remplies et on insère les nouvelles valeurs.

On boucle sur tous les disques en effet, ce n'est rien, on a une condition qui dit qu'on ne retient que le K et le S. C'est la fonction récursive Parcourir qui allonge le temps d'exécution.

Mais cette partie va probablement être remplacée par les répertoires déterminés grâce à un folderpicker ou saisis en dur.

Et je n'ai pas regardé le fichier donc je n'ai pas compris ta suggestion sur l'évènement mais cette macro ne doit pas être déclenchée par un évènement, elle est trop longue.

Erreur 70 : accès non autorisé

Erreur 76 : fichier non trouvé

D'où le besoin de faire un traitement d'erreur "On error goto..."

Oui, je comprends ton point de vue. Mais je me dis qu'il vaut faire sans le temps des essais car ça revient à enterrer le problème sans en déterminer la cause. De mon côté, sur C, je n'ai pas cette erreur donc je pense qu'il doit y avoir un moyen de comprendre la raison de cette erreur et de la résoudre autrement.

Bon j'avais écris un roman pour expliquer, mais tout à disparu : je l'a fait courte.

J'ai créée deux fichiers avec deux modules distinct, pour tester dans les meilleurs conditions.

Fichier avec module 1 :

ici j'ai repris ton dernier code 3GB et j'ai effectué un recherche sur deux dossier les deux premiers concerne le k:\ : ici les chemins d'accès sont bien trouvé même si il y a quelques soucis (voir fichier), mais pour le dernier, celui qui se trouve sur la racine du S:\ aucun résultat.

Pour le second fichier avec module 2 :

Ici j'ai gardé le code avec la gestion des erreurs, et j'ai beau changer les cellules je n’obtient qu'un seul résultat, mais il est correct SPTPE envoie bien vers k:\SPTPE.

Je pense effectivement qu'imposer le dossier de recherches semble être la meilleur chose. Mais connaissant un peu VBA je saurais me débrouiller, mes collègues je ne suis pas certain, c'est pour cela que la boite de dialogue serai la meilleur chose (mais non obligatoire !)

Salut YouniCornnn,

Voici un essai en intégrant une boite de dialogue pour chaque lecteur :

Public dico As Object

Sub Filesearch()
Set fso = CreateObject("Scripting.filesystemobject")
Set dico = CreateObject("Scripting.dictionary")
With ActiveSheet.Cells(2, 1) '<<< ADAPTER : CELLULE CONTENANT MOT CLE
    For Each odrive In fso.drives
        If odrive.driveletter Like "[KS]" Then
            srep$ = ChoixRepertoire(odrive.rootfolder.Path)
            if srep = "" then msgbox "Annulation", 16: Exit sub
            Parcourir srep, .Value
        End If
    Next odrive
    With .Offset(, 1)
        .Resize(.End(xlDown).Row - .Row + 1).ClearContents
        If dico.Count > 0 Then .Resize(dico.Count) = Application.Transpose(dico.keys)
    End With
End With
Set dico = Nothing
End Sub

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
Set ofolder = fso.getfolder(spath)
On Error Resume Next
nb = ofolder.subfolders.Count
On Error GoTo 0
If nb > 0 Then
    For Each osubfolder In ofolder.subfolders
       If osubfolder.Attributes <= 48 Then
           If UCase(osubfolder.Name) Like "*" & UCase(MotCle) & "*" Then dico(osubfolder.Path) = ""
           Parcourir osubfolder.Path, MotCle
        End If
    Next osubfolder
End If
End Function

Function ChoixRepertoire(sracine as string) as string
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = sracine
    .Show
    if .selecteditems.count > 0 then ChoixRepertoire = .SelectedItems(1)
End With
End Function

De mon point de vue, il vaut mieux mettre un répertoire en dur dans le code, c'est plus simple et l'utilisateur n'interviendra jamais...

Cdlt,

Salut 3GB,

De bonnes nouvelles la veille de la veille du week-end !

Le code que tu m'as transmis fonctionne pour le lecteur K:\. comme tu peux le voir sur le fichier ci joint j'arrive à obtenir le chemin direct au sous-dossier.
En faisant une recherche à partir d'un nom incomplet "Fichier reporting" se dernier arrive à me trouver les 2 références (donc tout est correct). cependant, est-il réalisable que les différents chemins s'inscrivent dans la même cellule avec un retour à la ligne dans la cellule ?

Un fois avoir testé le lecteur K:\ j'ai fais la même chose pour le S:\, sur une seule recherche. Mais là, aucun résultat, soucis de permissions (pourtant aucun message) ?

Pour l'instant je pense qu'il faut que l'on se concentre sur le fonctionnement global de cette macro.

________________________________Important à lire_________________________

Je me dois d'être honnête avec vous. Ce matin je viens d'apprendre que mon contrat d'intérimaire ne serais pas renouvelé en fin de mois. Il nous reste donc 7 jours (5 jours ouvrés) pour mettre au point ce programme. Je suis plutôt déçu que cela se termine comme ça....

Comme le projet m’intéresse personnellement je compte tout de même continuer et même au-delà de mon contrat.

Se pose la question des tests en situation réelle. Connaissez vous des solutions pour installer des lecteur réseau virtuel afin de pratiquer les tests adéquats ?

J'espère sincèrement que le sujet ne sera pas abandonné, car je pense qu'il peut aider d'autres personnes pour d'autres soucis.

Bonjour,

Je passe le sujet en résolu, car même si toutes les conditions n'ont pas été remplie, le problème est quasiment résolu !

Merci à 3GB et scraper pour leur aide.

Pour rappel, su la dernière version fonctionne uniquement sur le lecteur k:\. Pour ceux qui souhaite s'en servir

A+

Salut YouniCornn,

Merci pour ce retour ! Désolé, ta première réponse était un peu passée inaperçue...

Pour le lecteur S, je pense qu'il s'agit d'un problème de permission plutôt que de code car tu ne rencontres pas le même problème avec le lecteur K (et la logique reste la même).

Oui, en principe, tu peux obtenir le résultat avec un retour à la ligne même si je pense qu'il vaut mieux avoir une liste.

Je suis désolé pour le non renouvellement de ton contrat ! En ce moment, j'ai assez peu de temps mais c'est un sujet qui m'intéresse donc n'hésite pas à relancer si besoin !

Très bonne soirée,

Rechercher des sujets similaires à "chemin acces dossier nom 2010"