[VB6/VBA] Sélectionner une liste de fichier avec explorateur Win

Septembre 2016


Sélectionner une liste de fichier (ou un seul) avec l'API GetOpenFileName.
Une fonction simplifiée utilisant l'explorateur Windows .
Ce code fonctionne également en VBA à condition d'adapter les contrôles.

Vous pouvez modifiez
  • Le titre
  • Le retour d'un seul fichier en enlevant la constante OFN_ALLOWMULTISELECT
  • Explorateur ancienne version en enlevant la constante OFN_EXPLORER

Le code


'*********************************
'Auteur -> Lermite222
'Sélection d'une liste de fichiers
'avec l'explorateur Windows
'Version 1
'29/01/2012
'*********************************

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Enum LnFlags
    OFN_ALLOWMULTISELECT = &H200
    OFN_CREATEPROMPT = &H2000
    OFN_ENABLEHOOK = &H20
    OFN_ENABLETEMPLATE = &H40
    OFN_ENABLETEMPLATEHANDLE = &H80
    OFN_EXPLORER = &H80000
    OFN_EXTENSIONDIFFERENT = &H400
    OFN_FILEMUSTEXIST = &H1000
    OFN_HIDEREADONLY = &H4
    OFN_LONGNAMES = &H200000
    OFN_NOCHANGEDIR = &H8
    OFN_NODEREFERENCELINKS = &H100000
    OFN_NOLONGNAMES = &H40000
    OFN_NONETWORKBUTTON = &H20000
    OFN_NOREADONLYRETURN = &H8000
    OFN_NOTESTFILECREATE = &H10000
    OFN_NOVALIDATE = &H100
    OFN_OVERWRITEPROMPT = &H2
    OFN_PATHMUSTEXIST = &H800
    OFN_READONLY = &H1
    OFN_SHAREAWARE = &H4000
    OFN_SHOWHELP = &H10
End Enum



Private Sub Command1_Click()
Dim Retour As String, i As Integer
Dim TB
    Retour = ListeFichier()
    If Retour = "" Then Exit Sub 'L'utilisateur à annuler
    
    TB = Split(Retour, vbNullChar) ' Séparation de la liste si existe
    If UBound(TB) = 0 Then 'un seul fichier sélectionner
        For i = Len(TB(0)) To 1 Step -1
            If Mid(TB(0), i, 1) = "\" Then Exit For
        Next
        List1.AddItem Mid(TB(0), i + 1)
        TB(0) = Left(TB(0), i)
    Else 'Une liste est disponnible
        For i = 1 To UBound(TB)
            List1.AddItem TB(i)
        Next
    End If
    Label1.Caption = TB(0)
End Sub

Private Sub Command2_Click()
    List1.Clear
    Label1 = ""
End Sub

Function ListeFichier() As String
Dim Ret As Long
Dim LN_Ouv As OPENFILENAME
    LN_Ouv.lStructSize = Len(LN_Ouv)
    LN_Ouv.hWndOwner = Me.hWnd
    LN_Ouv.hInstance = App.hInstance
    LN_Ouv.lpstrFilter = "Musique (*.mp3)" + Chr$(0) + "*.mp3" + Chr$(0) + "Tous (*.*)" + Chr$(0) + "*.*" + Chr$(0)
    LN_Ouv.lpstrFile = String$(1024, vbNullChar)
    LN_Ouv.nMaxFile = Len(LN_Ouv.lpstrFile) - 1 ' Longueur maximum de la sélection des fichiers.
    LN_Ouv.lpstrTitle = "Sélection liste de fichier" ' Titre de l'explorateur
    
    ' directive pour le mode d'affichage.
    LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER
    ' Affichage de l'explorateur
    Ret = GetOpenFileName(LN_Ouv)
    If Ret = 0 Then
        ListeFichier = ""
    Else
        ListeFichier = Left$(LN_Ouv.lpstrFile, InStr(1, LN_Ouv.lpstrFile, vbNullChar & vbNullChar) - 2)
    End If
End Function

Téléchargement


Vous pouvez télécharger le projet
Liste fichiers.zip
Oubliez pas de le déziper

A voir également :

Ce document intitulé «  [VB6/VBA] Sélectionner une liste de fichier avec explorateur Win  » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.