Limiter repertoire

Bonjour à tout le monde,
Voilà le probleme auquel je suis confronté:j'ai créé une appli qui donne le choix à l'utilisateur de choisir le fichier à ouvrir dans une boite de dialogue avec une arborescence.
Cependant,je voudrais limiter le choix de l'utilisateur,et faire en sorte que dans la boite de dialogue ne s'affiche que le répertoire voulu.
Voici le code ,surement faut il changer quelque chose,ou bien faire autre chose.
Toutes les suggestions seront les bienvenues .
Merci d'avance pour votre attention.
'

Sub Import_data()
NomFichier = Application.GetOpenFilename
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & NomFichier, Destination _
:=Range("A1"))
.Name = "JLV_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 2, 2, 1, 5, 1, 2, 2, 2, 2, 2, 1, 1, 1, 2, 1, 1, 2, 2, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub