VBA / VB6 - Επιλέξτε μια λίστα αρχείων με την Εξερεύνηση των Windows

Επιλέξτε μια λίστα αρχείων (ή μία μόνο) με το API: GetOpenFileName.

Μια απλοποιημένη λειτουργία χρησιμοποιώντας την Εξερεύνηση των Windows.

Αυτός ο κώδικας λειτουργεί επίσης στο VBA υπό τον όρο ότι προσαρμόζετε τα στοιχεία ελέγχου.

Μπορείς να αλλάξεις

ο τίτλος
Η επιστροφή ενός μόνο αρχείου, αφαιρώντας τη σταθερή OFN_ALLOWMULTISELECT
Η παλιά έκδοση του Explorer, αφαιρώντας τη σταθερή OFN_EXPLORER

Ο κώδικας

 '*************************************' Auteur -> Lermite222 'Ενεργοποίηση της λίστας των δεδομένων με 'exploreateur Windows' Έκδοση 1 '29 / 01/2012 '************************************* Ιδιωτική Δηλώστε Λειτουργία GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilename ως OPENFILENAME) Όσο μακρύς ιδιωτικός τύπος OPENFILENAME lStructSize όσο Long hwndOwner όσο Long hInstance όσο Long lpstrFilter ως String lpstrCustomFilter ως String nMaxCustFilter As Long nFilterIndex As Long lpstrFile ως String nMaxFile As Long lpstrFileTitle String nMaxFileTitle Εφ lpstrInitialDir Όπως String lpstrTitle Όπως σημαίες String Εφ nFileOffset Όπως Integer nFileExtension Όπως Integer lpstrDefExt Όπως String lCustData Εφ lpfnHook Εφ lpTemplateName Όπως String Τέλος Τύπος Δημόσια 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 = & Η4 OFN_LONGNAMES = & H200000 OFN_NOCHANGEDIR = & Η8 OFN_NODEREFERENCELINKS = & H100000 OFN_NOLONGNAMES = & H40000 OFN_NONETWORKBUTTON = & H20000 OFN_NOREADONLYRETURN = & H8000 OFN_NOTESTFILECREATE = & H10000 OFN_NOVALIDATE = & H100 OFN_OVERWRITEPROMPT = & Η2 OFN_PATHMUSTEXIST = & H800 OFN_READONLY = & Η1 OFN_SHAREAWARE = & Η4000 OFN_SHOWHELP = & H10 End Enum Private Sub Command1_Click () (Retour, vbNullChar) 'Αποσύνδεση από τη λίστα και υπάρχει Αν το UBound (TB) = 0 Στη συνέχεια 'un seule fichier sélectionner Για i = Len (TB (0)) Σε 1 βήμα -1 Εάν Mid (TB (0), i, 1) = "\" Τότε Exit For Next List1.AddItem Mid ), i + 1) TB (0) = Αριστερά (TB (0), i) Άλλες πληροφορίες διαθέσιμες για i = 1 σε UBound (TB) List1.AddItem TB (0) End Sub Private Command2_Click () List1.Clear Label1 = "" Τέλος Sub Λειτουργία ListeFichier () Ως String Dim Ret As L ong Dim LN_Ouv Ως OPENFILENAME LN_Ouv.lStructSize = Len (LN_Ouv) LN_Ouv.hWndOwner = Me.hWnd LN_Ouv.hInstance = App.hInstance LN_Ouv.lpstrFilter = "Μουσική (* .mp3)" + Chr $ (0) + "* .mp3 "+ Chr $ (0) +" Tous (*. *) "+ Chr $ (0) +" *. (LN_Ouv.lpstrFile) - 1 'Longueur maximum de la sélection des fichiers. LN_Ouv.lpstrTitle = "Κατάλογος επιλογών" Οδηγία για την εξερεύνηση του περιβάλλοντος. (LN_Ouv.flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER 'Affichage de l'explorateur Ret = GetOpenFileName (LN_Ouv) Αν Ret = 0 Στη συνέχεια ListeFichier = "" Else ListeFichier = Left $ (LN_Ouv.lpstrFile, InStr (1, LN_Ouv.lpstrFile, vbNullChar & vbNullChar) - 2) Τέλος εάν τελειώσει η λειτουργία