web-dev-qa-db-fra.com

VBA Excel Obtenir le chemin du fichier (se termine par le dossier)

D'après une question précédente, je sais comment permettre à l'utilisateur de cliquer sur un bouton "Navigateur" et de rechercher un fichier spécifique qu'il pourrait vouloir ouvrir.

Code:

Private Sub CommandButton2_Click()
    Dim vaFiles As Variant

    vaFiles = Application.GetOpenFilename()

    ActiveSheet.Range("B9") = vaFiles
End Sub

Je souhaite créer un deuxième bouton de navigateur qui permettra à l'utilisateur de naviguer dans un dossier. Ce dossier va être où ils sauvegardent le fichier .pdf que mon programme crée. Voici le problème: La GetOpenFilename nécessite que l'utilisateur clique sur un fichier. S'il n'y a pas de fichier dans le dossier, l'utilisateur ne peut rien faire.

J'espère que c'était assez clair ...

Je vous remercie

8
Jesse Smothermon

Utilisez l'objet Application.FileDialog

Sub SelectFolder()
    Dim diaFolder As FileDialog

    ' Open the file dialog
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show

    MsgBox diaFolder.SelectedItems(1)

    Set diaFolder = Nothing
End Sub
21
chris neilsen

Ajoutez-y ErrorHandler au cas où l'utilisateur clique sur le bouton d'annulation au lieu de sélectionner un dossier. Ainsi, au lieu de recevoir un message d'erreur horrible, vous obtenez le message selon lequel un dossier doit être sélectionné, puis la routine se termine. Le code ci-dessous stocke également le chemin du dossier dans un nom de plage (qui est simplement lié à la cellule A1 sur une feuille).

Sub SelectFolder()

Dim diaFolder As FileDialog

'Open the file dialog
On Error GoTo ErrorHandler
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = "Select a folder then hit OK"
diaFolder.Show
Range("IC_Files_Path").Value = diaFolder.SelectedItems(1)
Set diaFolder = Nothing
Exit Sub

ErrorHandler:
Msg = "No folder selected, you must select a folder for program to run"
Style = vbError
Title = "Need to Select Folder"
Response = MsgBox(Msg, Style, Title)

End Sub
5
Derek

Dans le menu Outils de l'éditeur VBA, cliquez sur Références ..., sélectionnez "Microsoft Shell Controls And Automation" et choisissez-le.

Sub FolderSelection()
    Dim MyPath As String
    MyPath = SelectFolder("Select Folder", "")
    If Len(MyPath) Then
        MsgBox MyPath
    Else
        MsgBox "Cancel was pressed"
    End If
End Sub

'Both arguements are optional. The first is the dialog caption and
'the second is is to specify the top-most visible folder in the
'hierarchy. The default is "My Computer."

Function SelectFolder(Optional Title As String, Optional TopFolder _
                         As String) As String
    Dim objShell As New Shell32.Shell
    Dim objFolder As Shell32.Folder

'If you use 16384 instead of 1 on the next line,
'files are also displayed
    Set objFolder = objShell.BrowseForFolder _
                            (0, Title, 1, TopFolder)
    If Not objFolder Is Nothing Then
        SelectFolder = objFolder.Items.Item.Path
    End If
End Function

Lien source .

2
ray

Utilisez Application.GetSaveAsFilename() de la même manière que vous avez utilisé Application.GetOpenFilename()

1
jonsca

Si vous souhaitez rechercher un dossier par défaut: Par exemple, "D:\Default_Folder" Initialisez simplement l'attribut "InitialFileName".

Dim diaFolder As FileDialog

' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.InitialFileName = "D:\Default_Folder"
diaFolder.Show
0
Lah Ezcen

Cela pourrait vous aider:

Sub SelectFolder()
    Dim diaFolder As FileDialog
    Dim Fname As String

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show

    Fname = diaFolder.SelectedItems(1)

    ActiveSheet.Range("B9") = Fname

End Sub
0
Bhagwat Singh