Home » , » Open Multiple File Dialog Menggunakan Common Dialog - VB6

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.


multiple dialog open image

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

0 komentar:

Posting Komentar