Comment ouvrir un dossier avec VBA [Résolu]

Réponse 2 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Modifie seulement la macro afficheListeDossier
l'utilisateur devra valider le message!

c'est toi qui choisit

Public Sub AfficherListeDossiers(ByVal specdossier As String, ByRef Fso, ByVal leChemin)

Dim j As Integer
Dim msgStatusBarre As String
Dim s As Variant

msgStatusBarre = Application.DisplayStatusBar ' sauvegarde
s = MsgBox("Recherche du dossier contenant ... " & leChemin, vbInformation, "Information recherche")
    Dim dossier, fd, sDossier  ' variable de type variant
   ' Set Fso = CreateObject("Scripting.FileSystemObject") ' créé un objet fileSystem
    Set dossier = Fso.GetFolder(specdossier)             ' dossier : héritage de fso
    Set sDossier = dossier.SubFolders                    'sDossier : héritage de dossier
    j = 0
    For Each fd In sDossier                 ' Scanne la collection sDossier
        j = j + 1
        If (j Mod 2) = 0 Then  ' mise à jour du message tous les 20 dossiers
            Application.StatusBar = j & " traités sur : " & sDossier.Count
        End If
        
        If InStr(1, fd.Name, V) > 0 Then
            V = fd
            Exit For
        End If
    Next
   Set sDossier = Nothing
   Set dossier = Nothing
   Application.StatusBar = False
   Application.DisplayStatusBar = msgStatusBarre
End Sub

Réponse 3 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Bonjour,
ce que tu souhaites faire n'est pas clair ou incomplet.

On ne peut pas ouvrir un dossier ( au sens d'ouvrir comme un fichier),
Dans l'explorateur windows quand tu vois le dossier "ouvert" cela signifie que tu te positionnes à cet emplacement.
en vba on utilise CHDIR (LeCheminComplet)

Dans ton cas on pourrait avoir un dossier de travail C:\Travail\ dans lequel il y a ton classeur Excel et quand tu récupères "E1234"
tu pourrais avoir quelque chose comme ça...

Dim maVariable As String

maVariable="E1234" ' là je lui mets directement la valeur

Chdir (ThisWorbook.path & "\" & maVariable)

supercopain

Bonjour, et encore merci pour votre aide!
j'essai d'être un peut plus claire....

Depuis ma liste (excel) je selectionne la cellule qui contient le numéro du rapport, je clique sur un "bouton"qui active la macro ci-dessous et elle m'affiche le fichier PDF

Option Explicit
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub PDF_rapports()
Dim NomFichier
Dim tempo
Dim cel
tempo = Left(ActiveCell.Value, 6)
NomFichier = "g:\DOCU\R&D\Rapports d'essais\" + tempo + ".pdf"
If Dir(NomFichier) <> "" Then
ShellExecute 0, "open", NomFichier, "", "", 0
Else
If Dir(NomFichier) = "" Then
NomFichier = "g:\DOCU\R&D\Rapports d'essais\" + tempo + ", rapport d'essai.pdf"
ShellExecute 0, "open", NomFichier, "", "", 0
Else
MsgBox "Chemin ou fichier introuvable."
End If
End If

NomFichier = "g:\DOCU\R&D\Rapports d'essais\" + ActiveCell.Value + ".pdf"
If Dir(NomFichier) <> "" Then
ShellExecute 0, "open", NomFichier, "", "", 0
Else

End If

End Sub

je souhaiterai faire le même style de macro qui me permet de consulter le DOSSIER ou sont stocké les mesures de CE rapport

(je ne suis pas un expert, j'ai récupéré et modifié la macro ci-dessus)

supercopain

re bonjour, je vais commencer par le début,

....avant la liaison entre le numéro et le dossier se faisait par un lien hypertext, (dans mon tableau récapitulatif je cliquais sur la cellule qui contenais le numéro) et hop sa ouvrais mon dossier, mais cela augmente et ralentit beaucoup trop la consultation du fichier.

je vous remercie d'avance!

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

je regarde et je dis

Réponse 4 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

j'ai compris ce que tu veux faire

Comme ça!

Sub test()

ShellExecute 0, "explore", "G:\Docu\R&D\Rapports d'essais", "", "", 10

End Sub

supercopain

presque mais me manque encore l'ouverture du dossier spécifié dans la liste
exemple:
si dans mon tableau excel que j'utilise comme répertoire des fichiers et des dossiers de test je selectionne la cellule qui contient E1234 ma macro affiche le fichier correspondant (E1234, rapport d'essai.pdf)
Je voudrai qui l'en soit de même pour m'afficher le contenu du dossier qui commence par ce même nom (E 1234, dossier blabla)
mais attention la fin du nom peut être chaque fois différent, mais il commence toujours par E 1234, ) "E" "espace" "numéro essai" "," "espace" "blabla" chaque test a son numéro: 1235...1236

Pas facile à expliquer... désolé...
merci beaucoup

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

là je ne comprends plus ce que tu ne comprends pas ....
dans
ShellExecute 0, "explore", "G:\Docu\R&D\Rapports d'essais", "", "", 10

et hop sa ouvrais mon dossier Alsacien?

"Je voudrai qui l'en soit de même pour m'afficher le contenu du dossier qui commence par ce même nom (E 1234, dossier blabla) "
Je ne sais pas ce qu'il y as dans le dossier spécifié...
si tu me dis ... dans le dossier\...\ E1234\ j'ai des pdf qui s'appelle E1234.htm, 1234essai.pdf, 1234 rapport.doc, 1234truc.asp,
Je vois que tu es dans ton univers tu sais de quoi tu parles mais j'ai du mal à te suivre.
Explique mieux s'il te plait

Réponse 6 / 14

Supercopain

c'est exactement ça je suis dans mon truc et pour l'expliquer...

Alors en 1er j'ouvre mon tableau excel appelé "Gestion des essais.xls" dans lequel il y a une colonne qui répertorie tout les numéros d'essais (E1234.....)
et de ce numéro (1 par essai)
en 2éme je souhaite ouvrir le dossier qui porte CE numéro E1234.. (qui se trouve dans le répertoire G/docu/retd/essais terminés)

la macro qui est plus haut je l'utilise pour ouvrir uniquement les PDF (ordre d'essai et les rapports d'essai) qui se trouvent dans les dossiers "Ordres d'essais" et "Rapport d'essai"

voila je vais vous laisser tranquille,

MERCI POUR VOTRE AIDE

supercopain

Bonjour, aprés cette pause de qq jours je vais essayer formuler ma demande autrement,
Je cherche une macro qui est activée par un bouton(placé dans un classeur .xls)
->Dans mon classeur .xls (elle contient une liste récapitulative des N°essais) je selectionne la cellule du N°essai que je souhaite ouvrir.
->Et en cliquant sur le bouton, j'active ma macro qui doit ouvrir CE DOSSIER.
*******************************************************
Avant : un lien hypertexte remplissait cette mission mais alourdi et ralentit beaucoup le fichier récapitulatif .xls

Merci pour beaucoup et bonne journée

Réponse 7 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

je te propose de faire comme ça

sur la feuille qui contient les valeurs d'essai ( un essai = un repertoire)
click de droit sur l'onglet et choisi : code

tu colles ce code .....

Option Explicit




Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim C, V

If Not Intersect(Target, Range("A2:A80")) Is Nothing Then  ' la plage qui contient les essais
    Application.ScreenUpdating = False
    V = ActiveCell.Value
    If V <> "" Then
        ShellExecute 0, "explore", "G:\Docu\R&D\Rapports d'essais" & V, "", "", 10
       '  ShellExecute 0, "explore", "C:\Data\" & V, "", "", 10
    End If
End If
End Sub

dans un module tu devras mettre la fonction
comme ceci, si elle existe déjà inutile de la remettre.

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Explication :Quand tu click sur une cellule de ta liste d'essai cela déclenche la macro
si la cellule est vide tu ne fais rien sinon tu ouvres le répertoire avec l'explorateur.

Réponse 8 / 14

supercopain

Hello,
J'ai testé ça fonctionne,
mais (hé oui il y un mais..)
1-je veux que la macro soit activée par un bouton appelé : [OUVRIR LE DOSSIER]

et en plus, il faut tenir compte uniquement des 6 premiers caractéres (nom du dossier par exemple: E 1234, blabla)

Un grand merci pour votre précieuse aide.

Réponse 9 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Bonjour,

Excuse-moi j'avais oublié ce détail,

Dans un module
copie et colle le code ci-dessous.

Ajoute un bouton sur ta feuille, affecte-lui la macro et test

Attention il faut enlever le code précédent que tu as placé dans la feuille,
sinon il y aura un problème.

Option Explicit  

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _  
(ByVal hwnd As Long, ByVal lpOperation As String, _  
ByVal lpFile As String, ByVal lpParameters As String, _  
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long  


Sub OuvreDossier()  

Dim Target As Range  

Dim C, V  

Set Target = ActiveCell  


If Not Intersect(Target, Range("A2:A80")) Is Nothing Then  ' la plage qui contient les essais  
    Application.ScreenUpdating = False  
    V = Left(ActiveCell.Value, 6)     ' on ne prend que 6 charatères  
    If V <> "" Then  
        ShellExecute 0, "explore", "G:\Docu\R&D\Rapports d'essais" & V, "", "", 10  
        ' ShellExecute 0, "explore", "C:\Data\" & V, "", "", 10  
    End If  
End If  

End Sub

supercopain

Bonjour,
Et merci pour la rapidité
ça marche mais...
Je vais paraître pénible, mais les 6 premiers caractères à prendre en compte lors de la recherche, sont dans le nom du dossier, et en plus il contient un 'espace' entre le "E" et le chiffre, exemple de nom de dossier : E 1234, blabla
En résumé, mes noms de dossier comportent toujours un espace après le "E" (E 1234, blabla) (-> et ils doivent conserver leurs noms <-)
Et dans ma plage (liste Excel) qui contient le N° d'essais il n'y a pas d'espace après le "E" (E1234)
et de cette liste je souhaite ouvrir le dossier nommé: "E 1234, blabla"

Voilà mon problème
Merci A+ ...j'éspère...

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Je pense que que tu veux dire que tu as une liste excel avec "E1234, blabla" donc 5 charactères avant la virgule et tu veux E 1234 ( le nom du dossier soit 6 charactères).
il faut être précis et utiliser le vocabulaire approprié.
L'opération consiste à extraire E1234 et ajouter un espace après le premier charactère.
je le fais...

Réponse 10 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Option Explicit   

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _   
(ByVal hwnd As Long, ByVal lpOperation As String, _   
ByVal lpFile As String, ByVal lpParameters As String, _   
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long   


Sub OuvreDossier()   

Dim Target As Range   

Dim C, V   

Set Target = ActiveCell   


If Not Intersect(Target, Range("A2:A80")) Is Nothing Then  ' la plage qui contient les essais   
    Application.ScreenUpdating = False   
    v = Left(Replace(ActiveCell.Value, "E", "E ", 1), 6)  ' remplace "E1234,blabla" par "E 1234"  
    If V <> "" Then   
        ShellExecute 0, "explore", "G:\Docu\R&D\Rapports d'essais" & V, "", "", 10   
        ' ShellExecute 0, "explore", "C:\Data\" & V, "", "", 10   
    End If   
End If   

End Sub

supercopain

Ah non, c'est exactement l'inverse, c'est la liste qui n'a pas d'espace et 5 charactéres et le nom de Dossier qui a un espace et 6 charactères au minimum.

mais j'essaie le code comme ça

Merci a+

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

C'est ce que j'ai dis et écris !!! que cela soit accompli ! lol

supercopain

on va finir par se comprendre,

Voici comment se presente ma liste de numéro :
E1230
E1231
E1232
E1233
E1234
E12...

et depuis cette liste de numéro je veux rechercher le dossier et tous les dossiers commencent par le numéro et ensuite deux mots pour situer ce que c'est comme test.
Exemple de nom de dossier : E 1233, mesure de puissance

ton code fonctionne correctement SI le nom du fichier est E 1234 (nom avec espace aprés le "E")

Je te remercie A+

Patience et longueur de temps....

Réponse 11 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

j'ai fais le test pas de pb chez moi.

il faut que tu adaptes au besoin la variable chainePath
A+

Option Explicit
Public idxTablo As Integer
Public TabloDossier() As String

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Sub OuvreDossier()

Dim Target As Range

Dim C, V
Dim i As Integer


Dim chainePath As String

Set Target = ActiveCell
chainePath="G:\Docu\R&D\Rapports d'essais"
'chainePath = "C:\Data\2009"

If Not Intersect(Target, Range("A2:A20")) Is Nothing Then  ' la plage qui contient les essais
    Application.ScreenUpdating = False
   
    V = Left(Replace(ActiveCell.Value, "E", "E ", 1), 6)
    
    idxTablo = 0
    ReDim Preserve TabloDossier(idxTablo)
    TabloDossier(idxTablo) = chainePath
    idxTablo = 1
    Call AfficherListeDossiers(chainePath, CreateObject("scripting.filesystemobject"))
    For i = 0 To UBound(TabloDossier)
        If InStr(1, TabloDossier(i), V) > 0 Then
            V = TabloDossier(i)
            Exit For
        End If
        
    Next
    
    If V <> "" Then
        'ShellExecute 0, "explore", V, "", "", 10
        ShellExecute 0, "explore", V, "", "", 10
    End If
End If

End Sub






Public Sub AfficherListeDossiers(ByVal specdossier As String, ByRef Fso)

    Dim dossier, fd, sDossier  ' variable de type variant
   ' Set Fso = CreateObject("Scripting.FileSystemObject") ' créé un objet fileSystem
    Set dossier = Fso.GetFolder(specdossier)             ' dossier : héritage de fso
    Set sDossier = dossier.SubFolders                    'sDossier : héritage de dossier
                                   
    ReDim Preserve TabloDossier(idxTablo)          ' variable globale
  
   
    For Each fd In sDossier                 ' Scanne la collection sDossier
        ReDim Preserve TabloDossier(idxTablo)
        TabloDossier(idxTablo) = fd.Path
   
        idxTablo = idxTablo + 1

    Next
   Set sDossier = Nothing
   Set dossier = Nothing
  
If TabloDossier(UBound(TabloDossier)) = "" Then
    ReDim Preserve TabloDossier(UBound(TabloDossier) - 1)
End If

 
 
End Sub

supercopain

SUPER CA MARCHE!
Merci beaucoup!!
Mais, ça va long environ 15 à 20 secondes a chaque fois que je lance la macro avant que s'affiche le dossier. Est-ce normal?
Ou alors, afficher un message qui annonce que le fichier est en cour de recherche et qu'il faut patienter.

Merci merci et merci!

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

oui! c'est normal! je regarde si on peut optimiser.
le problème vient du fait que je scanne tous les dossiers et les place dans un tableau
ensuite il suffit de lire le tableau et de comparer, on sort de la boucle quand on trouve.

Réponse 12 / 14

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Essaye ce code!
et supprime le précédent tu devrais gagner en vitesse.
je n'ai pas mis le message '...en cours de recherche...'
Tu test et tu dis.

Option Explicit  
Public V As String  

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _  
(ByVal hwnd As Long, ByVal lpOperation As String, _  
ByVal lpFile As String, ByVal lpParameters As String, _  
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long  


Sub OuvreDossier()  

Dim Target As Range  

Dim i As Integer  

V = ""  
Dim chainePath As String  

Set Target = ActiveCell  
chainePath = "G:\Docu\R&D\Rapports d'essais"  
'chainePath = "C:\Data"    

If Not Intersect(Target, Range("A2:A20")) Is Nothing Then  ' la plage qui contient les essais  
    Application.ScreenUpdating = False  
     
    V = Left(Replace(ActiveCell.Value, "E", "E ", 1), 6)  

    Call AfficherListeDossiers(chainePath, CreateObject("scripting.filesystemobject"), V)  

      
    If V <> "" Then  

        ShellExecute 0, "explore", V, "", "", 10  
    End If  
End If  

End Sub  






Public Sub AfficherListeDossiers(ByVal specdossier As String, ByRef Fso, ByVal leChemin)  
'  
' il faut déclarer i en global  
'  
    Dim dossier, fd, sDossier  ' variable de type variant  
   ' Set Fso = CreateObject("Scripting.FileSystemObject") ' créé un objet fileSystem  
    Set dossier = Fso.GetFolder(specdossier)             ' dossier : héritage de fso  
    Set sDossier = dossier.SubFolders                    'sDossier : héritage de dossier  
                                     

    For Each fd In sDossier                 ' Scanne la collection sDossier  
      
        If InStr(1, fd.Name, V) > 0 Then  
            V = fd            
           Exit For  
        End If  

    Next  
   Set sDossier = Nothing  
   Set dossier = Nothing  
    
   
End Sub

supercopain

Salut,
Erreur de syntaxe et y me met ça en rouge -> V = fd Exit For
??
j'ai oublié quelques chose?

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

    For Each fd In sDossier                 ' Scanne la collection sDossier  
      
        If InStr(1, fd.Name, V) > 0 Then  
            V = fd            
           Exit For  
        End If  

    Next

j'ai modifié le massage 'Exit for se trouve à la ligne
une petite modification qui s'est pas bien passée.

Question combien as-tu d'essais ou de répertoires?

supercopain

ça marche mais au niveau du temps rien à changé, c'est peut-être à cause du nombre de dossier??
Il y en a environ 1500

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

Ben oui je crois que c'est à cause de ça.
je t'ajoute un petit truc comme ça tu sauras que la machine n'a pas planté !!

Réponse 13 / 14

supercopain

Hello,
Tout fonctionne avec affichage dans la barre en bas ... mais, je souhaiterai (je sais, je suis pénible..)
un message ou une indication de chargement qui ferait patienter l'utilisateur (ce n'est pas toujours moi qui l'utilise)

Merci.

Réponse 14 / 14

supercopain

Ok ça marche! Super!!
Je vais tester pendant quelques temps cette nouvelle version de mon fichier.
J'ai fini de t'ennuyer avec mes questions,... enfin pour le moment...
heuu, encore une petite question comment je fais pour "mettre en résolu"

Merci beaucoup et bon week-end!

Bidouilleu_R Messages postés 1181 Date d'inscription Statut Membre Dernière intervention 295

reviens sur le premier post et tu trouveras la possibilité
de mettre en résolu.
A+

debutant_en_macro

Merci beaucoup pour ton aide Bidouilleu_R!!!

je suis tombé sur ce forum par hasard, étant débutant en macro je m'arrange pour trouver les macros nécessaires au bon fonctionnement de ma trame de devis.tu m'as aidé à la finaliser (pour le moment lol) merci encore!

Comment ouvrir un dossier avec VBA

14 réponses

Votre réponse

Discussions similaires