Open Multiple File Dialog Menggunakan Common Dialog - VB6

Terkadang didalam pemrograman, seringkali kita membutuhkan dialog yang dapat membuka lebih dari satu file (multiple), misalnya digunakan untuk pembuatan software Mass Renamer, Multiple Upload (ftp Client), Multiple Attachment (Email via Code), File Destroyer, dll.

Kode di bawah ini berguna untuk membuka lebih dari satu file (multiple) melalui CommonDialog. Kode ini telah disusunkan sedemikian rupa, agar tidak memiliki variable diluar prosedur, tujuan utamanya ialah supaya memiliki sifat mudah digunakan kembali (reusable). Di samping itu kode ini akan mudah di-encapsulate dalam bentuk dll atau ocx.

'simpan kode ini dalam Module 
Option Explicit 
 
Public Function GetMultipleFiles(cdlOpen As Object, Optional ByVal sTitle As String = "Open files...") As String 
    Dim sFilenames As String 
    On Error GoTo ProcError 
    ' Get the desired name using the common dialog 
    Set cdlOpen = CreateObject("MSComDlg.CommonDialog") 
    ' set up the file open dialog file types 
    With cdlOpen 
        ' setting CancelError means the control will 
        ' raise an error if the user clicks Cancel 
        .CancelError = True 
        .Filter = "VB Files *.frm;*.bas;*.cls;*.res;*.ctl;*.dob;*.pag;*.dsr)|*.frm;*.bas;*.cls;*.res;*.ctl;*.dob;*.pag;*.dsr|Form Files *.frm)|*.*.frm|Basic Files *.bas)|*.bas|All Files *.*)|*.*" 
        .FilterIndex = 1 
        .DialogTitle = sTitle 
        .MaxFileSize = &H7FFF ' 32KB filename buffer 
        ' same as .Flags = cdlOFNHideReadOnly Or  cdlOFNPathMustExist Or cdlOFNLongNames Or cdlOFNAllowMultiselect or cdlOFNExplorer 
        .Flags = &H4 Or &H800 Or &H40000 Or &H200 Or &H80000 
        .ShowOpen 
        sFilenames = .Filename 
    End With 
ProcExit: 
    GetMultipleFiles = sFilenames 
    Set cdlOpen = Nothing 
    Exit Function 
ProcError: 
    If Err.Number = &H7FF3 Then Resume Next 'Cancel selected - Ignore 
    MsgBox Err.Description & "(" & Err.Number & ")", vbExclamation, "Open error" 
    sFilenames = "" 
    Resume ProcExit 
End Function 

Contoh penggunaan prosedure di atas:

Option Explicit 
 
'simpan kode ini dalam Form 
Private Sub Command1_Click() 
   Dim Filename As Variant 
   Dim i As Integer 
   Filename = Split(GetMultipleFiles(cdlOpen), Chr(0)) 
       For i = 1 To UBound(Filename) 
           List1.AddItem Filename(0) & "\" & Filename(i) 
       Next 
End Sub