Membuat kotak dialog browse for forderMembuat kotak dialog browse for forder

Minggu, 07 Maret 2010

Membuat kotak dialog browse for forder


Pertama-tama buat project baru :
1. tambahkan form dan sebuah command button
2. buat sebuah module
ketikkan script kode berikut pada module


Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260
Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

kemudian untuk menampilkan kotak dialog tersebut pada saat comamnd button di klik ketik script berikut :
Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
'Ganti 'This Is My Title' dengan judul yang ingin Anda 'letakkan pada kotak dialog "Browse For Folders" 'tersebut.
szTitle = "This Is My Title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + _
BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
'Nilai sBuffer adalah directori yang dipilih oleh
'user pada kotak dialog.
sBuffer = Left(sBuffer, InStr(sBuffer, _
vbNullChar) - 1)
MsgBox sBuffer
End If
End Sub


--semoga bermanfaat--

Tidak ada komentar:

Posting Komentar