Discussion :

[minifrix]

Bonjour,
Je viens vous demander de l'aide car cela fait une semaine que je découvre le VBA et 5 jours ou je suis coincé.
Je m'explique, j'ai réussi à faire un UserForm pour pouvoir rechercher des pdf qui se trouvent dans des dossier et sous dossier et ensuite ouvrir les différents fichiers que j'aurais sélectionné dans la ListBox..

Alors pour l'instant tout marche (Quitter, Explorer, TextBox, ListBox, Label1) sauf :
-le bouton "find" qui ne va pas dans les sous dossier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Private Sub Find_Click()
 Dim Result As Variant
    Dim NomFichier As String
    Dim Dossier As String
    Dim Nb As Long
 
    Dossier = TextBox1.Value
    Chemin = "C:\test\" & Dossier
 
    ListBox1.Clear
    Nb = 0
        NomFichier = Dir(Chemin & "*.*")
            While NomFichier <> ""
            ListBox1.AddItem NomFichier
            NomFichier = Dir
            Nb = Nb + 1
        Wend
    Label1.Caption = Nb & " fichiers"
        If Nb = 0 Then
        MsgBox "le fichier n'existe pas", vbInformation + vbOKOnly, "ERREUR"
        End If
End Sub

- le bouton ouvrir qui pour l'instant n'ouvre rien ! (le critère multi sélection de la ListBox est activé)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Ouvrir_Click()
Dim ws As Worksheet
Dim Chemin As String
Dim NomFichier As String
 
    Set ws = ActiveSheet
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    NomFichier = ListBox1 & ".pdf"
 
    ThisWorkbook.FollowHyperlink ".pdf"
 
    Set ws = Nothing
 
End Sub

Si quelqu'un pourrait m'aider à corriger mes codes svp.
Je cherche mais je n'arrive pas à trouver ou a adapter les codes à mes besoins.
Par avance merci.

Pour montrer à quoi ressemble mon projet :

Le code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Private Sub Explorer_Click()
Dim MonDossier As String
MonDossier = "C:\test\"
 
Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus
End Sub
 
Private Sub Find_Click()
 Dim Result As Variant
    Dim NomFichier As String
    Dim Dossier As String
    Dim Nb As Long
 
    Dossier = TextBox1.Value
    Chemin = "C:\test\" & Dossier
 
    ListBox1.Clear
    Nb = 0
        NomFichier = Dir(Chemin & "*.*")
            While NomFichier <> ""
            ListBox1.AddItem NomFichier
            NomFichier = Dir
            Nb = Nb + 1
        Wend
    Label1.Caption = Nb & " fichiers"
        If Nb = 0 Then
        MsgBox "le fichier n'existe pas", vbInformation + vbOKOnly, "ERREUR"
        End If
End Sub
 
Private Sub Ouvrir_Click()
Dim ws As Worksheet
Dim Chemin As String
Dim NomFichier As String
 
    Set ws = ActiveSheet
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    NomFichier = ListBox1 & ".pdf"
 
    ThisWorkbook.FollowHyperlink ".pdf"
 
    Set ws = Nothing
 
End Sub
 
Private Sub Quitter_Click()
 UserForm2.Hide
End Sub

et mon UserForm

[kiki29]

Salut, voir Visualisation d'une liste de fichiers PDF dans une UserForm via IExplorer ou aussi Liste des fichiers d'un dossier avec recherche récursive ou non via les APIs en les adaptant à ton contexte.

A lire

[minifrix]

Merci pourle coup de main,
mais d'entrée j'ai des erreur avec le via Iexplorer.
Du coup en cherchant a adapter les codes, ben , pas mieux.
Désolé mais quand on est débutant on est chiant .

[kiki29]

Salut, désolé mais je dis et répète : je ne pratique pas l'extispicine et donc ce genre de message n'apporte rien, d'autant plus qu'ici tout fonctionne.

[minifrix]

Ben si tu ne vois rien dans les viscères, essaye la boule de cristal !
Sinon blague à part,
d'entrée, étant en 64 bits il me dit que ce n'est pas compatible.
je force et j'essaye d'utiliser le user form et là :
bouton repertoire : erreur de compilation Sub ou function non défini.
Quand je lis le code du bouton ouvrir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
Dim sFichier As String, WsShell As Object
    sFichier = Me.TextBox1
    If Len(sFichier) = 0 Then Exit Sub
    Set WsShell = CreateObject("WScript.Shell")
    WsShell.Run "AcroRd32 " & sFichier
    Set WsShell = Nothing
End Sub

J'essaye de le mettre mais moi c'est ce qui est sélectionné dans la ListBox1 que je veut ouvrir et quand je remplace Me.TextBox1 par ListBox1 ça ne marche pas.
Désolé d'avoir été trop direct et sans info.

[patricktoulon]

re
bonsoir
si je devine par raport au titre "ouverture pdf / recherche sous dossier"
je suppose que tu a du mal avec les subdossiers
il y a 2 méthodes que je connais la méthode avec dir en récursivité mais c'est assez capricieux "dir" n'étant pas récursif il faut tamponner chaque fin de dir
ou la méthode avec la librairie Scripting qui elle est beaucoup moins contraignante vis a vis des tampons
le principe étant de partir d'un dossier ,lister les sous dossier et a chaque étape lister avec "dir" les fichiers
voici une petite fonction qui te liste tout tes pdf qui se trouve dans un dossier et ses sous dossiers dans la fenêtre d'exécution avec le chemin complet

la fonction devient le tableau des fichiers avec le chemin complet bien sur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
'=======================================================================================================
'              OBJECT  : FONCTION DE RECHERCHE RECURSIVE AVEC L'OBJECT SCRIPTING.FILESYSTEMOBJECT      =
'              createur  patricktoulon pour developpez.com                                             =
'               date de création  27/06/2010                                                           =
'=======================================================================================================
Sub test()
    tabl = listdosssubdoss("C:\Users\polux\Desktop\testrecursiverecheche", "*.pdf") 'chemin entre guillemets a adapter
    'exemple d'utilisation on va transposer la liste sur le sheets
    Sheets(1).Cells(1, 1).Resize(UBound(tabl), 1) = Application.Transpose(tabl)
End Sub
Function listdosssubdoss(dparent, ext, Optional L As String) As Variant
    Dim FSO As Object, oFolder As Object, sous_dossier As Object, Ficher   'Scripting.Folder
    fichier = Dir(dparent & "\" & ext) ' a chaque passage on liste avec dire sur une extention en l'occurence ici "pdf"
    Do While fichier <> ""
        'Debug.Print dparent & "\" & fichier
        L = L & dparent & "\" & fichier & vbCrLf ' on alimente une liste dans une vriable de type texte
        fichier = Dir ' on redemande tant qu'il y a quelque chose
    Loop
    Set FSO = CreateObject("scripting.filesystemobject") ' on declare l'object
    Set oFolder = FSO.GetFolder(dparent) 'on attribue a l'object.getfolder le dossier demandé
    For Each sous_dossier In oFolder.SubFolders 'on boucle sur les dossiers qui sont dans ce dossiers
        'Debug.Print sous_dossier.Path
        listdosssubdoss sous_dossier.Path, ext, L ' on rappelle la fonction avec pour argument le chemin du sous dossier
    Next sous_dossier
    listdosssubdoss = Split(L, vbCrLf) 'on coupe la liste par les saut de lignes on a maintenant un array la fonction devient cet array
End Function

si ca peut servir

[minifrix]

merci pour ton aide,
mais là tu es déja trop loin pour moi.
mon problème avec les sous dossier c'est qu'avec mon code du bouton find,
je ne recherche que dans c:\test\ mais si j'ai des fichiers qui sont dans c:\test\dossier\ par exemple, et bien ils ne sont pas vu.
je recherche donc la modif a faire sur mon code afin de pouvoir explorer aussi les sous dossier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Find_Click()
 Dim Result As Variant
    Dim NomFichier As String
    Dim Dossier As String
    Dim Nb As Long
 
    Dossier = TextBox1.Value
    Chemin = "C:\test\" & Dossier
 
    ListBox1.Clear
    Nb = 0
        NomFichier = Dir(Chemin & "*.*")
            While NomFichier <> ""
            ListBox1.AddItem NomFichier
            NomFichier = Dir
            Nb = Nb + 1
        Wend
    Label1.Caption = Nb & " fichiers"
        If Nb = 0 Then
        MsgBox "le fichier n'existe pas", vbInformation + vbOKOnly, "ERREUR"
        End If
End Sub

merci.