afficher les fichiers d'un dossier, modification du code

[satwaf]

Bonjour à tous,
voila j'aimerai afficher les fichiers XLS ou XLSX d'un dossier, j'ai donc récupérer un bout de code , mais j'aimerai l'adpater à mon application.
je m'explique, lors de l'ouverture du fichier, j'ai un auto_open, qui liste les fichiers du dossier dans lequel se trouve le fichier, seulement il prend l'ensemble des fichiers, alors que moi j'aimerai uniquement les fichiers excel, et deuxiemement, il affiche le nom du fichier actuel, et je souhaiterai qu'il ne l'affiche pas, pensez vous que pouvez m'aider

Sub auto_open()
Dim Dossier As Object, Fichier As Object
nom2 = ActiveWorkbook.Name

Dim Chemin As String
Dim I As Long
Columns("b:b").Select
Selection.ClearContents
'Chemin du dossier à analyser (à adapter au besoin)
'Chemin = "C:\Documents and Settings\cor\Bureau\RC_lab2"

'ou Dossier actuel
Chemin = ThisWorkbook.Path


'Définition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)

' Boucle sur les fichiers
For Each Fichier In Dossier.Files


I = I + 1
'Fichiers avec extension
'Cells(I, 2) = Fichier.Name ' Nom du fichier

'Fichiers sans extension
Cells(I, 2) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1)
Next
End Sub

 

[MJ13]

Re : afficher les fichiers d'un dossier, modification du code

Bonjour Satwaf

Un début de piste à adapter. Pour exclure un fichier voir avec like .

Sub Liste_Fichiers()
'http://forum.hardware.fr/hfr/Programmation/VB-VBA-VBS/liste-fichiers-repertoire-sujet_57846_1.htm
    'ChDir "C:\...Mon chemin....\Mes documents"
    'Range("2:1000").Clear
    Range(Cells(2, 1), Cells(65536, 1)).Clear
            Dim i  As Integer, z As String
        ChDrive Left(Cells(1, 2), 1)
    ChDir Cells(1, 2).Value
    i = 1
z = Dir("*.txt", 1)
    While z <> ""
    ActiveSheet.Cells(i + 1, 1).Value = z
    i = i + 1
    z = Dir
    Wend
End Sub

 

[Softmama]

Re : afficher les fichiers d'un dossier, modification du code

Bonjour satwaf,

Essaie ainsi, à tester :

Sub auto_pen()
' Nécessite la référence Microsoft Scripting Runtime
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim I As Long
Columns("b:b").Select
Selection.ClearContents
'Chemin du dossier à analyser (à adapter au besoin)
'Chemin = "C:\Documents and Settings\cor\Bureau\RC_lab2"
'ou Dossier actuel
Chemin = ThisWorkbook.Path

'Définition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)

' Boucle sur les fichiers
For Each Fichier In Dossier.Files
  If Fichier.Name <> ThisWorkbook.Name Then 'On n'affiche pas le fichier ouvert
    If Mid(Fichier.Name, InStr(Fichier.Name, ".")) Like ".xl*" Then 'On affiche que les fichiers excel
      I = I + 1
      Cells(I, 2) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1)
    End If
  End If
Next
End Sub

 

[satwaf]

Re : afficher les fichiers d'un dossier, modification du code

merci a vous pour vos reponse, j'ai donc essayé ton code softmama, le seul probleme, c'est que le nom du classeur ouvert est affiché dans la liste sous forme je pense de fichier temporaire, du style: ~$afficher les fichiers du dossier

 

[satwaf]

Re : afficher les fichiers d'un dossier, modification du code

ca fonctionne parfaitement avec ce code, encore merci a vous pour votre aide

Sub CommandButton1_Click()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim I As Long
Columns("b:b").Select
Selection.ClearContents
'Chemin du dossier à analyser (à adapter au besoin)
'Chemin = "C:\Documents and Settings\cor\Bureau\RC_lab2"
'ou Dossier actuel
Chemin = ThisWorkbook.Path

'Définition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)

' Boucle sur les fichiers
For Each Fichier In Dossier.Files
'If Fichier.Name <> ThisWorkbook.Name Then 'On n'affiche pas le fichier ouvert
If Fichier.Name <> "~$" & ThisWorkbook.Name Then 'On n'affiche pas le fichier ouvert
If Fichier.Name <> ThisWorkbook.Name Then 'On n'affiche pas le fichier ouvert
If Mid(Fichier.Name, InStr(Fichier.Name, ".")) Like ".xl*" Then 'On affiche que les fichiers excel
I = I + 1
'Fichiers avec extension
Cells(I, 2) = Fichier.Name ' Nom du fichier
'Fichiers sans extension
'Cells(I, 2) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1)
End If
End If
End If
Next

End Sub

 

[MJ13]

Re : afficher les fichiers d'un dossier, modification du code

Re

Sinon, tu peux le faire ainsi:

Sub Liste_Fichiers_Inputbox_Ext_DossierEnCours()
'http://forum.hardware.fr/hfr/Programmation/VB-VBA-VBS/liste-fichiers-repertoire-sujet_57846_1.htm
'ChDir "C:\...Mon chemin....\Mes documents"
'Range("2:1000").Clear
    Dim i As Integer, z As String
    Sheets.Add
    'Range(Cells(2, 1), Cells(65536, 1)).Clear
    Ext = InputBox("Extension de fichiers à touver ?")
    'ChDrive Left(Cells(1, 2), 1)
    ChDrive Left(ThisWorkbook.Path, 1)
    'ChDir Cells(1, 2).Value
    ChDir ThisWorkbook.Path
    i = 1
    'z = Dir("*.txt", 1)
    z = Dir("*." & Ext, 1)
    While z <> ""
        If z <> ActiveWorkbook.Name Then ActiveSheet.Cells(i + 1, 1).Value = z: i = i + 1
        z = Dir
    Wend
End Sub