Memilih Directory dng UserForm

Kadang kita perlu mengambil file dari directory tertentu dalam aplikation Excel. Kita dapat menggunakan method GetOpenFileName untuk mendisplay sebuah user dialog yang meminta sebuah file (file name), akan tetapi kita tidak diberi pilihan untuk mendisplay sebuah dialog box that yang menunjukkan hanya directory saja. Dalam tulisan ini saya mencobah menyajikan sebuah fungsi yang diberi nama AmbilDirektori yang akan menampilkan dialog box seperti di bawah ini dan menghasilkan string yang menunjukkan directory yang terpilih. Jika user anda mengklik cancel, maka fungsi ini akan menghasilkan string kosong (empty). Fungsi AmbilDirektori memerlukan satu argument, tapi tidak wajib (optional). Argumen ini adalah variable a string yang akan ditampilkan dalam dialog box. Jika argumen tidak disertakan maka dialog box menampilkan pesan Pilih folder.

AmbilDirektori function

Fungsi AmbilDirektori adalah sebagai berikut. Untuk menggunakannya cukup copykan ke module VBA. Sebagai alternatif ambil contoh disini

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
’32-bit API declarations
Declare Function SHGetPathFromIDList Lib “shell32.dll” _
Alias “SHGetPathFromIDListA” (ByVal pidl As Long, ByVal pszPath As String) _
As Long
Declare Function SHBrowseForFolder Lib “shell32.dll” _
Alias “SHBrowseForFolderA” (lpBrowseInfo As BROWSEINFO) As Long
Sub UjiCoba()
Dim Msg As String
Msg = “Contoh: Pilih lokasi untuk backup.”
MsgBox AmbilDirektori(Msg)
End Sub
Function AmbilDirektori(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = “Pilih folder.”
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
AmbilDirektori = Left(path, pos – 1)
Else
AmbilDirektori = “”
End If
End Function


Cara menggunakan fungsi AmbilDirektori

Berikut subrutin sederhana untuk memakai fungsi AmbilDirektori

Sub UjiCoba()

Dim Msg As String

Msg = ” Contoh: Pilih lokasi untuk backup!!”

MsgBox AmbilDirektori(Msg)

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *