Langsung aja kita kepokok pembahasan bagaimana dengan pembuatan Coding nya, nah bagi yang tertarik silakan ikuti langkah - langkah berikut ini
Ketik Coding Berikut ini pada Module Project
Option Explicit
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
'Fungsi mencek keberadaan folder
Public Function DirectoryExist(DirPath As String) As Boolean
DirectoryExist = Dir(DirPath, vbDirectory) <> ""
End Function
'Fungsi untuk membuat Folder
Public Sub CreateNewDirectory(NewDirectory As String)
Dim sDirTest As String
Dim SecAttrib As SECURITY_ATTRIBUTES
Dim bSuccess As Boolean
Dim sPath As String
Dim iCounter As Integer
Dim sTempDir As String
sPath = NewDirectory
If Right(sPath, Len(sPath)) <> "\" Then
sPath = sPath & "\"
End If
iCounter = 1
Do Until InStr(iCounter, sPath, "\") = 0
iCounter = InStr(iCounter, sPath, "\")
sTempDir = Left(sPath, iCounter)
sDirTest = Dir(sTempDir)
iCounter = iCounter + 1
'create directory
SecAttrib.lpSecurityDescriptor = &O0
SecAttrib.bInheritHandle = False
SecAttrib.nLength = Len(SecAttrib)
bSuccess = CreateDirectory(sTempDir, SecAttrib)
Loop
End Sub
'Fungsi Untuk Menghapus folder
Public Sub DelDirectory(sName as String)
On Error Resume Next
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
If Dir(sName, vbDirectory) <> "" Then
Fso.DeleteFolder sName
End If
Set Fso = Nothing
End Sub
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
'Fungsi mencek keberadaan folder
Public Function DirectoryExist(DirPath As String) As Boolean
DirectoryExist = Dir(DirPath, vbDirectory) <> ""
End Function
'Fungsi untuk membuat Folder
Public Sub CreateNewDirectory(NewDirectory As String)
Dim sDirTest As String
Dim SecAttrib As SECURITY_ATTRIBUTES
Dim bSuccess As Boolean
Dim sPath As String
Dim iCounter As Integer
Dim sTempDir As String
sPath = NewDirectory
If Right(sPath, Len(sPath)) <> "\" Then
sPath = sPath & "\"
End If
iCounter = 1
Do Until InStr(iCounter, sPath, "\") = 0
iCounter = InStr(iCounter, sPath, "\")
sTempDir = Left(sPath, iCounter)
sDirTest = Dir(sTempDir)
iCounter = iCounter + 1
'create directory
SecAttrib.lpSecurityDescriptor = &O0
SecAttrib.bInheritHandle = False
SecAttrib.nLength = Len(SecAttrib)
bSuccess = CreateDirectory(sTempDir, SecAttrib)
Loop
End Sub
'Fungsi Untuk Menghapus folder
Public Sub DelDirectory(sName as String)
On Error Resume Next
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
If Dir(sName, vbDirectory) <> "" Then
Fso.DeleteFolder sName
End If
Set Fso = Nothing
End Sub
Nah sekarang tinggal menggunakan fungsi-fungsi tersebut kedalam Form Project sebagai contoh membuat sebuah folder di drive C dengan nama Database coding nya seperti dibawah ini
'Coding untuk mebuat Folder
'Cek dulu Folder
If DirectoryExist("C:\Database") <> True Then
'Jika Folder yg dimaksud belum ada maka akan dibuat
Call CreateNewDirectory("C:\Database\")
'Coding Menghapus Folder
'Kalau Folder yang dimaksud ditemukan langsung dihapusCall DelDirectory ("C:\Database\")
'Cek dulu Folder
If DirectoryExist("C:\Database") <> True Then
'Jika Folder yg dimaksud belum ada maka akan dibuat
Call CreateNewDirectory("C:\Database\")
'Coding Menghapus Folder
'Kalau Folder yang dimaksud ditemukan langsung dihapusCall DelDirectory ("C:\Database\")
Cukup sekian dulu tutorial singkat ini mudah-mudahan kalau ada umur panjang akan saya lanjutkan pada topik yang lain, semoga dapat membantu dan bermamfaat, selamat mencoba dan salam.
Tidak ada komentar:
Posting Komentar