VBA / VB6 - Välj en lista med filer med Utforskaren i Windows

Välj en lista med filer (eller en enda) med API: GetOpenFileName.

En förenklad funktion med hjälp av Utforskaren.

Denna kod fungerar också i VBA förutsatt att du justerar kontrollerna.

Du kan förändra

titeln
Återkomsten av en enda fil genom att ta bort konstanten OFN_ALLOWMULTISELECT
Den gamla versionen av Explorer genom att ta bort konstant OFN_EXPLORER

Koden

 '*********************************' Författare -> Lermite222 'Sélection d'une lista de fichiers' avec l 'explorateur Windows' Version 1 '29 / 01/2012 '********************************* Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilnamn som OPENFILENAME) Så länge privattyp OPENFILENAME lStructSize så länge hWndOwner så länge hInstance så länge lpstrFilter som sträng lpstrCustomFilter som sträng nMaxCustFilter så länge nFilterIndex så länge lpstrFile som sträng nMaxFile så länge lpstrFileTitle As Long String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flaggor som Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Typ 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 = & H10 00 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 Retur som sträng, jag som heltal Dim TB Retour = ListFichier () Om Retour = "" Sedan Avsluta Del "Utnyttjande avbryta TB = Split (Retur, vbNullChar) 'Uppdatering av lista existe Om Ubound (TB) = 0 Då 'un seul fichier sélectionner För I = Len (TB (0)) Till 1 Steg -1 Om Mid (TB (0), I, 1) = "\" Avsluta För Nästa List1.AddItem Mid (TB ), i + 1) TB (0) = Vänster (TB (0), i) Annan 'Une list est disponnible För i = 1 Till Ubunden (TB) List1.AddItem TB (i) Nästa Slut Om Label1.Caption = TB (0) Avsluta Sub Private Sub Command2_Click () List1.Clear Label1 = "" End Sub Function ListFichier () Som String Dim Ret ong Dim LN_Ouv Som 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 lista de fichier" "Titre de l'explorateur" Direktivet om läget för affischen. LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_ALLPLORER 'Affichage de l'explorateur Ret = GetOpenFileName (LN_Ouv) Om Ret = 0 Då ListFichier = "" Annan ListFichier = Vänster $ (LN_Ouv.lpstrFile, InStr (1, LN_Ouv.lpstrFile, vbNullChar & vbNullChar) - 2) Sluta om slutfunktion