[XL-2010] Récupérer le nom d’un fichier dans un répertoire spécifique

[modus57]

Bonjour.

Comment ouvrir un répertoire spécifique, laisser choisir un fichier par l’utilisateur et récupérer le non de ce fichier.

J’ai une petite procédure qui fonctionne, mais la boîte de dialogue s’ouvre 2 fois, c’est gênant et je n’arrive pas à corriger le problème.

Voici le:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub VarNomFichier()
Dim Rep As String
Rep = "C:\Users\Public\Documents\" 'Chemin et répertoire à ouvrir
If Dir(Rep, vbDirectory) <> "" Then
    Application.Dialogs(xlDialogOpen).Show Rep
    Rep = Application.GetOpenFilename()
    tmpStr = Split(Rep, "\")
    nomFichier = tmpStr(UBound(tmpStr))
    MsgBox nomFichier
Else
   MsgBox "Chemin introuvable"
End If
End Sub

J’ai recherché sur internet je n’ai pas trouvé de solution.

Pourriez-vous me donner une piste svp.

Merci d’avance pour votre réponse.

[mercatog]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub VarNomFichier()
Dim nomFichier As String
Dim tmpStr, Rep
 
Rep = "C:\Users\Public\XXX\"                                       'Chemin et répertoire à ouvrir
If Dir(Rep, vbDirectory) <> "" Then
    Rep = Application.GetOpenFilename()
    If Rep <> False Then
        tmpStr = Split(Rep, "\")
        nomFichier = tmpStr(UBound(tmpStr))
        MsgBox nomFichier
    Else
        MsgBox "Action annulée"
    End If
Else
    MsgBox "Chemin introuvable"
End If
End Sub

[modus57]

Bonsoir mercatog.

Merci pour ta réponse.

J’ai testé ton code, mais il ouvre le dernier répertoire ouvert et malgré le chemin indiqué " C:\Users\Public\XXX\".

Je ne comprends pas pourquoi ?

[mercatog]

Mettre un Chdir et si Rep sur un autre disque, mettre Chdrive (F1)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub VarNomFichier()
Dim nomFichier As String
Dim tmpStr, Rep
 
Rep = "C:\Users\user\desktop\"                                       'Chemin et répertoire à ouvrir
If Dir(Rep, vbDirectory) <> "" Then
    ChDir Rep
    Rep = Application.GetOpenFilename()
    If Rep <> False Then
        tmpStr = Split(Rep, "\")
        nomFichier = tmpStr(UBound(tmpStr))
        MsgBox nomFichier
    Else
        MsgBox "Action annulée"
    End If
Else
    MsgBox "Chemin introuvable"
End If
End Sub

[modus57]

Bonjour mercatog

J’ai testé ton code modifié, mais sauf erreur de ma part il faut positionner ChDir Rep avant If Dir(Rep, vbDirectory) <> "" Then.

Cordialement.

[mercatog]

Non, cette ligne test l'existence du répertoire Rep

Code :

If Dir(Rep, vbDirectory) <> "" Then

Si Rep existe donc on change le répertoire par défaut à l'aide de Chdir

Si on mets Chdir avant et que Rep n'existe pas=>

Erreur 76, Chemin d'accès introuvable.

[modus57]

Excusez-moi j’ai fait une boulette, effectivement il ne faut pas changer la ligne «ChDir Rep».

En progressant dans ma procédure je rencontre un petit souci.

Le principe de celle-ci, consiste à copier dans la feuille A un champ nommé «fiche_originale» situé dans la feuille B comportant des liaisons avec un autre fichier.

Après collage une boîte de dialogue «Mettre à jour les valeurs: original.01.xlsm» apparaît une 1ère fois, il faut appuyer sur «ESCP ou Annuler», puis cette même boîte de dialogue apparaît une 2ème fois.

Dans cette 2ème boîte de dialogue l’utilisateur choisi le fichier, le nom de celui-ci est récupérer afin de remplacer la valeur "original.01.xlsm" par le nom du fichier choisi.

Voici le code :

Code :

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
 
Dim nomFichier As String
Dim tmpStr, Rep
 
Columns(1).Find("*", , , , , xlPrevious).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert
Range("fiche_originale").Copy
ActiveSheet.Paste 
 
Rep = "C:\Users\user\desktop\"  'Chemin et répertoire à ouvrir
If Dir(Rep, vbDirectory) <> "" Then
    ChDir Rep
    Rep = Application.GetOpenFilename()
    If Rep <> False Then
        tmpStr = Split(Rep, "\")
        nomFichier = tmpStr(UBound(tmpStr))
        MsgBox nomFichier
        Cells.Replace What:="original.01.xlsm", Replacement:=nomFichier,   LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Else
        MsgBox "Action annulée"
    End If
Else
    MsgBox "Chemin introuvable"
End If

Comment corriger ce code pour éviter que la boîte de dialogue « Mettre à jour les valeurs : » apparaisse 2 fois.

Avez-vous une idée à proposer.

Merci d’avance pour votre réponse.