Discussion :

[goninph]

Bonjour,

Voici le code que j'utilise

J'aimerais afficher que les fichiers du type feuille de calcul

Merci pour aide
Philippe

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
Option Explicit
Sub Ouvrir_Dossier()
Dim MonDossier As String
    MonDossier = ThisWorkbook.Path & "\Suivi des fins de chantiers\" & ActiveCell.Value
    If DossierExiste(MonDossier) = True Then 'Si le dossier existe
        Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus 'Ouvrir le dossier
    Else 'Si le dossier n'existe pas
        MkDir (MonDossier) 'Créer le dossier
        Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus 'Ouvrir le dossier
    End If
End Sub
Public Function DossierExiste(MonDossier As String)
   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function

[njhub]

Bonjour,

pourquoi ne pas utiliser MSDOS puisque vous êtes sous windows?

La commande DIR permet de choisir le type de fichier à répertorier, et génère un fichier à coller dans votre tableur

Dans l'exemple ci-dessous
on est à la racine du disque C:
on cherche tout fichier avec l'extension .XLXS
et | CLIP permet de générer un fichier qui sera disponible dès que tout le disque aura été scruté,
visible quand la commande C:\> réapparait

[goninph]

Bonjour,

Merci pour cette info, mais je veux juste ouvrir le dossier et ne voir que les fichiers Excel, comme si on le faisait manuellement avec le filtre de la colonne Type de l'explorateur de fichier

[goninph]

J'ai toujours pas trouvé, est-ce possible ?

[Philippe Tulliez]

Bonjour,
Pour lister les fichiers d'un répertoire donné, j'utilise une fonction générique utilisant la fonction Dir.
La fonction Dir acceptant les caractères génériques tels que ? et *, il suffit donc pour n'avoir la liste que des fichiers Excel, de filtrer le chemin complet avec "*xls*" ou "*xlsx", etc.
La fonction renvoie soit un Array soit une chaîne vide.

Cette fonction n'accepte pas les chemins type SharePoint (hhtp\...)

Code de la fonction

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function FileList(ByVal LookUpFullName As String) As Variant
  '  Renvoie une liste avec les fichiers présents dans le répertoire défini pas l'argument LookUpFullName
  '  Author  : Philippe Tulliez http://www.magicoffice.be
  ' Argument
  '   LookUpFullName (String) Répertoire + nom du fichier + extension
  Dim f As String, c As Integer, l As Variant
  f = Dir(LookUpFullName)
  Do Until Len(f) = 0
    If c Then ReDim Preserve l(c) Else ReDim l(c)
    l(c) = f: c = c + 1: f = Dir
  Loop
  FileList = l
End Function

Exemple d'une procédure qui l'invoque en renvoyant la liste des fichiers Excel d'un sous-répertoire nommé 2021

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
Sub TestFileList()
  Const SubFolder As String = "2021"
  Const Suffix As String = "*xls*"
  Dim RootPath As String
  Dim FullPath As String
  Dim m As String, e As Integer, S As String, t As Variant
  S = Application.PathSeparator
  RootPath = ThisWorkbook.Path
  FullPath = RootPath & S & SubFolder & S
  t = FileList(FullPath & Suffix)
  If IsArray(t) Then
     For e = LBound(t) To UBound(t)
       m = m & vbCrLf & t(e)
     Next
   Else
     m = "Aucun fichier correspondant"
  End If
  MsgBox m
End Sub

[jurassic pork]

Hello,
on peut aussi utiliser l'objet COM FSO. Exemple :

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
Sub GetList()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim temp As String
     'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
     'Get the folder object
    Set objFolder = objFSO.GetFolder("D:\Temp")
    For Each objFile In objFolder.Files
         temp = objFSO.GetExtensionName(objFile.Name)
         If (temp = "xls") + (temp = "xlsx") + (temp = "xlsm") Then
            Debug.Print objFile.Name
         End If
    Next objFile
End Sub

[EDIT] Avec l'opérateur Like on peut simplifier le test de l'extension :

Code :

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

If (temp Like "xls*") Then

Ami calmant, J.P

[goninph]

Nickel merci pour les 2 solutions

@Philippe Tulliez

Comment afficher cette liste dans une listbox d'un Userform ou mieux encore dans un tableau structuré ?

Ensuite au clic sur la ligne, je pourrais ouvrir le fichier ou je pourrais utiliser une combobox

Merci et bonne soirée

[Philippe Tulliez]

Bonjour,

Comment afficher cette liste dans une listbox d'un Userform

Comme je l'ai écrit, la fonction FileList dont j'ai publié le code renvoie une variable Array ou une chaîne vide donc il suffit si c'est une variable Array de passer à la propriété List d'un ListBox ou d'un ComboBox, son contenu.

Exemple

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
Sub TestFileList()
  Const SubFolder As String = "2021"
  Const Suffix As String = "*xls*"
  Dim RootPath As String
  Dim FullPath As String
  Dim m As String, e As Integer, S As String, t As Variant
  S = Application.PathSeparator
  RootPath = ThisWorkbook.Path
  FullPath = RootPath & S & SubFolder & S
  t = FileList(FullPath & Suffix)
  If IsArray(t) Then
     With UserForm1
     .ListBox1.List = t
     .Show
     End With
  End If
End Sub

[goninph]

C'est juste génial, un grand merci

Le code adapté à placer dans Userform

Au double-clic dans la Listbox, le fichier sélectionné s'ouvre

ou

Lors de la sélection dans la Combobox, le fichier sélectionné s'ouvre

Astuce pour éviter le beug de la sélection vide :

Code :

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

1
2
3
        Hauteur_Listbox1 = ListBox1.ListCount * 13.25
        Me.ListBox1.Height = Hauteur_Listbox1 'Dimensionne la hauteur pour éviter l'erreur si vide (pas de ligne vide)
        Me.Height = 61 + Hauteur_Listbox1

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
Option Explicit
Public Chemin As Variant
Private Sub UserForm_Initialize()
'Régler StartUpPosition 0-Manual. Centrer userform sur le fichier excel et non sur l'écran
Me.Left = Application.Left + Application.Width / 2 - Me.Width / 2 'Pour centrer sur l'application
Me.Top = Application.Top + Application.Height / 2 - Me.Height / 2 'Pour centrer sur l'application
Dim m As String, e As Integer, S As String, t As Variant, srep As String, Nombre_de_Fichier As String, Hauteur_Listbox1 As String
Const Suffix As String = "*xls*"
    S = Application.PathSeparator
'    Srep = "A:\Secteur Architectes\24 - Data"
    srep = ThisWorkbook.Path
    Chemin = srep & S
    t = FileList(Chemin & Suffix)
    If IsArray(t) Then
        With Me
            .ListBox1.List = t
        End With
        Me.Label_Nombre_Fichier = ListBox1.ListCount
        Hauteur_Listbox1 = ListBox1.ListCount * 13.25
        Me.ListBox1.Height = Hauteur_Listbox1 'Dimensionne la hauteur pour éviter l'erreur si vide (pas de ligne vide)
        Me.Height = 61 + Hauteur_Listbox1
    End If
End Sub
Private Sub Listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'Private Sub ListBox1_Click()
Dim Fichier As Variant
    Fichier = Me.ListBox1.List(, 0)  '0 = Première colonne
    'Important ShowModal = False pour éviter le beug lors de l'ouverture d'un autre fichier avec une invite via USF à l'ouverture
    Workbooks.Open Filename:=Chemin & Fichier ', ReadOnly:=True
    Unload Me
End Sub
Private Sub BT_Annuler_Click()
    Unload Me
End Sub
Function FileList(ByVal LookUpFullName As String) As Variant
'Author  : Philippe Tulliez http://www.magicoffice.be
'Renvoie une liste avec les fichiers présents dans le répertoire défini pas l'argument LookUpFullName
'Argument
'LookUpFullName (String) Répertoire + nom du fichier + extension
Dim f As String, c As Integer, l As Variant
    f = Dir(LookUpFullName)
    Do Until Len(f) = 0
        If c Then ReDim Preserve l(c) Else ReDim l(c)
        l(c) = f: c = c + 1: f = Dir
    Loop
    FileList = l
End Function