web-dev-qa-db-fra.com

VBA - Folder Picker - définir par où commencer

J'ai une petite application Access VBA qui oblige les utilisateurs à sélectionner un dossier. Je me demandais s'il y avait un moyen de dire à VBA le chemin à partir duquel démarrer le sélecteur de dossier. c'est-à-dire démarrer le sélecteur de dossier à C:\data\forms. Actuellement, il semble partir du répertoire précédemment utilisé. Il existe également un moyen de limiter l'accès du sélecteur de dossiers. Ainsi, il peut accéder à tout dans C:\data mais pas autre chose dans C:

vbams-accessaccess-vba
12
Finklesteinn

J'utilise le code suivant (Not My Code) avec succès depuis de nombreuses années.

enter image description here

Sub Sample()
    Dim Ret

    '~~> Specify your start folder here
    Ret = BrowseForFolder("C:\")
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level

    Dim ShellApp As Object

     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

     'Destroy the Shell Application
    Set ShellApp = Nothing

     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function
24
Siddharth Rout

Voici une méthode rapide et sale que j'utilise tout le temps. La fonction ci-dessous n'obtiendra que l'utilisateur de sélectionner le dossier dans lequel il souhaite démarrer - je pense que le moyen le plus simple de limiter l'accès à un chemin donné est peut-être de vérifier GetFolderName ci-dessous par rapport au (x) chemin (s) que vous souhaitez restreindre par exemple.

If GetFolderName = "C:\" then 
  MsgBox("This folder is not for you buddy")
  Exit Sub
end if

Pas non plus mon code :)

Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long

GetFolderName = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Show
    For lCount = 1 To .SelectedItems.Count
        GetFolderName = .SelectedItems(lCount)
    Next lCount
End With
End Function
14
artifex_knowledge

Si vous n'avez pas besoin de restreindre la vue des dossiers à votre utilisateur, je suggérerais d'utiliser la méthode FileDialog (l'interface est plus intuitive que ce que l'invocation du Shell vous donne). Pour plus de détails, vous pouvez en savoir plus sur le site de CPearson. Il a un long article sur la recherche de dossiers en utilisant VBA (plusieurs façons; l'option FileDialog est à la toute fin):

Function BrowseFolder(Title As String, _
    Optional InitialFolder As String = vbNullString, _
    Optional InitialView As Office.MsoFileDialogView = _
        msoFileDialogViewList) As String

Dim V As Variant
Dim InitFolder As String

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = Title
    .InitialView = InitialView
    If Len(InitialFolder) > 0 Then
        If Dir(InitialFolder, vbDirectory) <> vbNullString Then
            InitFolder = InitialFolder
            If Right(InitFolder, 1) <> "\" Then
                InitFolder = InitFolder & "\"
            End If
            .InitialFileName = InitFolder
        End If
    End If
    .Show
    On Error Resume Next
    Err.Clear
    V = .SelectedItems(1)
    If Err.Number <> 0 Then
        V = vbNullString
    End If
End With
BrowseFolder = CStr(V)
End Function

Cette fonction prend deux paramètres. Le premier, Titre est une chaîne spécifiant le titre à afficher avec la boîte de dialogue de fichier. Le deuxième InitialFolder, qui est facultatif, spécifie le dossier initial dans lequel la boîte de dialogue doit s'ouvrir. Le troisième paramètre, également facultatif, InitialView spécifie le type de vue. Voir MsoFileDialogView dans l'Explorateur d'objets pour les valeurs valides de ce paramètre. La fonction renvoie le nom de dossier complet sélectionné par l'utilisateur ou une chaîne vide si l'utilisateur a annulé la boîte de dialogue.

6
ChE Junkie

Voici une manière beaucoup plus simple. Cet extrait de code permet à l'utilisateur de choisir un dossier, puis imprime cette adresse de dossier à l'écran:

Sub PrintSelectedFolder()
    Dim selectedFolder

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        selectedFolder = .SelectedItems(1)
    End With

    'print to screen the address of folder selected
    MsgBox (selectedFolder)

End Sub
4
Matt C.

Pour les utilisateurs de mac:

Sub Select_Folder_On_Mac()
  Dim folderPath As String
  Dim RootFolder As String

  On Error Resume Next
  RootFolder = MacScript("return (path to desktop folder) as String")
  'Or use RootFolder = "Macintosh HD:Users:YourUserName:Desktop:TestMap:"
  folderPath = MacScript("(choose folder with Prompt ""Select the folder""" & _
     "default location alias """ & RootFolder & """) as string")
  On Error GoTo 0

  If folderPath <> "" Then
    MsgBox folderPath
  End If
End Sub

Volé à http://www.rondebruin.nl/mac/mac017.htm ;)

1
Sam