Ouvrir des fichiers dans un répertoire

Bonjour à tous,

J'ai besoin d'aide dans un code VBA.

Mon code va me permettre d'ouvrir plusieurs fichiers dans un même répertoire, tous les fichiers ont l'extension acsup.

J'arrive via la fonction shell.application à ouvrir un fichier acsup mais la ou je coince c'est que je suis obligé d'indiquer le chemin ou se trouve le fichier. J'aimerai juste indiquer le chemin du répertoire et la macro ouvre 1 à 1 les fichiers.

Voici le code qui me permet d'ouvrier l'ensemble des fichiers d'un répertoire, je bloque à l'étape ProcessFiles2 où je n'arrive pas à utiliser la commande shell.application, je la remplacer par exemple par Workbooks.Open FileName, cela m'ouvre bien l'ensemble des fichiers sous excel pour vérifier que l'ensemble de la macro marche.

Sub Repertoire()

'Choix du répertoire pour travailler

Dim Repertoire As FileDialog
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show

If Repertoire.SelectedItems.Count > 0 Then
    Rep_Traitement = Repertoire.SelectedItems(1)
    Call BatchProcess2 '---------------Macro ProcessFiles2 Traitement des feuilles une à une en fonction de la liste des agents
Else
    MsgBox "Aucun Répertoire Sélectionné. Relancez la macro"
    Exit Sub
End If

End Sub
Sub BatchProcess2()
    Dim Files() As String
    Dim FileSpec As String

'   Get file spec
    'DefaultPath = ThisWorkbook.Path & "\*.xlsm"
    FileSpec = Rep_Traitement & "\*.acsup"

'   See if any files exist
    FoundFile = Dir(FileSpec)
    If FoundFile = "" Then
        MsgBox "Cannot find file:" & vbCrLf & Rep_Traitement
        Exit Sub
    End If

'   Get first file name
    FileCount = 1
    ReDim Preserve Files(FileCount)
    Files(FileCount) = FoundFile

'   Get other file names, if any
    Do While FoundFile <> ""
        FoundFile = Dir()
        If FoundFile <> "" Then
            FileCount = FileCount + 1
            ReDim Preserve Files(FileCount)
            Files(FileCount) = FoundFile
        End If
    Loop

'   Loop through all files and process them
    For i = 1 To FileCount
        Application.StatusBar = "Processing " & Files(i)
        Call ProcessFiles2(Files(i))
    Next i
    Application.StatusBar = False

End Sub

Sub ProcessFiles2(FileName As String)

'   Import the file

    CreateObject("Shell.Application").Open Rep_Traitement & " \ " & FileName

    'Workbooks.Open FileName:=Rep_Traitement & " \ " & FileName
    traitement_feuille = ""
    agjr = 1

    'ActiveWorkbook.Close savechanges:=True

End Sub

Auriez-vous une idée svp ?

Bonjour Robor le forum

oui, et tu n'oublies surtout pas la première ligne, je ne peux pas tester mais cela devrait fonctionner

a+

Papou

Public rep$
Sub Repertoire()
    Dim Repertoire As FileDialog
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        rep = Repertoire.SelectedItems(1)
        Call BatchProcess2
    Else
        MsgBox "Aucun Répertoire Sélectionné. Relancez la macro"
        Exit Sub
    End If
End Sub

Sub BatchProcess2()
    Dim fichier$
    fichier = Dir(rep & "\*.acsup")
    Do While fichier <> ""
         CreateObject("Shell.Application").Open(rep & "\" & fichier)
        'ton traitement       
        fichier = Dir
    Loop
End Sub