THE INFORMATIQUE

THE INFORMATIQUE

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

 

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 



13/12/2012
0 Poster un commentaire

A découvrir aussi


Inscrivez-vous au blog

Soyez prévenu par email des prochaines mises à jour

Rejoignez les 2 autres membres