Modifier repertoire d'importation sur la feuille Excel

Bonjour,

j'ai un code d'importation de fichier, et j'aurais besoin de pouvoir modifier le répertoire source, là ou on récupère le fichier à importer, directement sur ma feuille Excel.

Par exemple, créer une petite fenêtre intitulée : " renseigner le répertoire source : " qui modifierait ensuite directement dans le code VBA le répertoire source.

Cela est-il possible ?

Sub Test1()
    Dim Fichier As String, Chemin As String
    Dim i As Long

    'Répertoire contenant les fichiers
    Chemin = "H:\repertoireA\test"
    Fichier = Dir(Chemin & "\*.*")

    'Boucle sur les fichiers
    Do While Fichier <> ""

        i = Range("A65536").End(xlUp).Row + 1
        ImportText1 Chemin & "\" & Fichier, Cells(i, 1)

        Fichier = Dir
    Loop
End Sub

Sub ImportText1(NomFichier As Variant, Cible As Range)
    Dim QT As QueryTable

    Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Cible)

    With QT
        'Définit les séparateur de colonnes dans le fichier txt
        .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh
    End With
End Sub

Excel 2003

Merci d'avance.

je te propose de créer une feuille supplémentaire, par exemple "parametre" dans laquelle dans la cellule A1 tu indiques le chemin.

le code ci-dessous est adapté pour aller chercher cette information.

Sub Test1()
    Dim Fichier As String, Chemin As String
    Dim i As Long

    'Répertoire contenant les fichiers
   Chemin = worksheets("parametre").range("A1").value
    Fichier = Dir(Chemin & "\*.*")

    'Boucle sur les fichiers
   Do While Fichier <> ""

        i = Range("A65536").End(xlUp).Row + 1
        ImportText1 Chemin & "\" & Fichier, Cells(i, 1)

        Fichier = Dir
    Loop
End Sub

Sub ImportText1(NomFichier As Variant, Cible As Range)
    Dim QT As QueryTable

    Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Cible)

    With QT
        'Définit les séparateur de colonnes dans le fichier txt
       .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh
    End With
End Sub

 

merci