Sélection fichier (MOL)

Parcourir et Sélectionner plusieurs fichiers (Mso Object Librairy)

 Sélectionner et retourner le chemin de un ou plusieurs fichiers séparés par un point-virgule.

La fonction a été  adaptée pour pouvoir indiquer un répertoire de départ et une extension.

Function fnOpenFiles(Optional InitialDir As String = "", _
                     Optional InitialExt As String = "") As String
    '/===========================================================
    '/ Nécessite la référence microsoft office x.x object library
    '/
    '/ Pour indiquer un chemin de départ :
    '/ X = fnOpenFiles("F:\Clients")
    '/
    '/ Pour ouvrir dans le répertoire de la base :
    '/ X = fnOpenFiles("Me")
    '/
    '/ Pour indiquer l'extension :
    '/ X = fnOpenFiles("F:\",".txt")
    '/===========================================================
    Dim Dialogue As FileDialog
    Dim Fichier As Variant, sPath As String, sExt As String
    Set Dialogue = FileDialog(msoFileDialogOpen)
    ' traiter le répertoire initail
    InitialDir = Trim(InitialDir)
    If Left(UCase(InitialDir), 2) = "ME" Then
        InitialDir = Application.CurrentProject.Path & "/"
    End If
    If Len(InitialDir) > 0 And Right(InitialDir, 1) <> "/" Then
        InitialDir = InitialDir & "/"
    End If
    'traiter l'extension
    Select Case InitialExt
        Case ".txt", ".mdb", ".xls", ".doc"
            sExt = "*" & InitialExt
        Case Else
            sExt = "*.*"
    End Select
    'traiter les propriétés
    With Dialogue
        .AllowMultiSelect = True
        .ButtonName = "Ouvrir"
        .InitialFileName = InitialDir
        .Filters.Clear
        If sExt <> "*.*" Then
            .Filters.add "Fichiers filtrés sur", sExt
        Else
            .Filters.add "Tous les fichiers", "*.*"
            .Filters.add "Base de données Microsoft Access", "*.mdb"
            .Filters.add "Tableur Microsoft Excel", "*.xls"
            .Filters.add "Document Microsoft Word", "*.doc"
        End If
        .InitialView = msoFileDialogViewList
        .Title = "Veuillez sélectionner les fichiers ..."
        If .Show Then
            For Each Fichier In .SelectedItems
                fnOpenFiles = fnOpenFiles & Fichier & ";"
            Next
        End If
    End With
    If Len(fnOpenFiles) > 0 Then
        fnOpenFiles = Left(fnOpenFiles, Len(fnOpenFiles) - 1)
    End If
    Set Dialogue = Nothing
End Function