Cara Membuat Handle Folder dan File Melalui UserForm VBA Excel

Handle Folder Melalui UserForm VBA Excel - Posting ini sangat membantu anda untuk membuat Folder secara otomatis pada partisi yang di inginkan,

Menghapus, Copy, dan Move Folder dan File melalui Diolog Box menggunakan VBA. Semua berkenaan dengan Explorer. 

Pelajari kodenya, Uji menggunakannya, anda akan tahu manfaat mempelajari ini dalam membangun aplikasi yang bagus. Banyak hal yang bisa diterapkan dalam menggunakan fasilitas yang disediakan pada posting ini.

Akan banyak sekali manfaatnya jika anda mencoba sendiri satu persatu kodenya, menerapkan dan mencoba menjalankannya.

• Buka Excel, dan selanjutnya Pilih Tab Developer, klik Visual Basic atau dengan jalan pintas keyboard tekan secara bersamaan tombol Alt+F11. 

• Jangan lupa disave dengan format Enable Macro atau Binary

• Pada Jendela Visual Basic rancang Aplikasi sesuai dengan gambar diatas. Tambahkan UserForm1 dengan Caption "Handle Folder dan File", tambahkan CommandButton1 dengan Caption "Ceks Folder",  

• tambahkan CommandButton2 dengan Caption "Open Folder", tambahkan CommandButton3 dengan Caption "Create Folder",  dan CommandButton Lain sesuai dengan kebutuhan kode dibawah nanti.

• Kode VBA Untuk Mengeceks Keberadaan Folders di Expolorer/Partisi. Klik kanan pada CommandButton1 dengan Caption "Ceks Folder", pilih View Code dan masukkan kode berikut ini 

Private Sub CommandButton1_Click()
Dim CFO
Dim cFolder As String

cFolder = "E:\Test Folder" ' Anda dapat mengubah lokasi yang lain
Set CFO = CreateObject("Scripting.FileSystemObject")

If CFO.FolderExists(cFolder) Then
MsgBox "Folder Telah Tersedia..!!", vbInformation, "Ceks Folder"
Else
MsgBox folder & "Folder Tidak Ditemukan..!!", vbInformation, "Ceks Folder"
End If
End Sub

• Kode VBA Untuk Membuka Folders di Expolorer/Partisi. Klik kanan pada CommandButton2 dengan Caption "Open Folder", pilih View Code dan masukkan kode berikut ini 

Private Sub CommandButton2_Click()
Dim CFO
Dim cFolder As String
cFolder = "E:\Test Folder" 'Anda dapat mengubah folder lain yang ingin di buka

Set CFO = CreateObject("Scripting.FileSystemObject")

If Not CFO.FolderExists(cFolder) Then
MsgBox "Folder Tidak Ditemukan..!!", vbInformation, "Handle Folder Dan File"
ElseIf CFO.FolderExists(cFolder) Then
Call Shell("explorer.exe " & cFolder, vbNormalFocus)
End If
End Sub

• Kode VBA Untuk Membuat Folder Baru di Expolorer/Partisi. Klik kanan pada CommandButton3 dengan Caption "Create Folder", pilih View Code dan masukkan kode berikut ini 

Dim CFO
Dim cFolder As String

cFolder = "E:\Test Folder" ' Anda dapat mengubahnya sesuai keinginan Nama folder yang akan dibuat
Set CFO = CreateObject("Scripting.FileSystemObject")

If Not CFO.FolderExists(cFolder) Then
CFO.CreateFolder (cFolder) 'Pengecekaan bila folder sudah ada
MsgBox "Folder Baru Selesai Di Buat..!!", vbExclamation, "Handle Folder Dan File"
Else
MsgBox "Folder Sudah Tersedia..!!", vbExclamation, "andle Folder Dan File"
End If

• Kode VBA Untuk Copy Folder ke lokasi lain di Expolorer/Partisi. Klik kanan pada CommandButton4 dengan Caption "Copy Folder", pilih View Code dan masukkan kode berikut ini 

Private Sub CommandButton4_Click()
Dim CFO
Dim cFolder As String, dFolder As String

cFolder = "E:\Test Folder\" 'ini lokasi data yang akan dicopy
dFolder = "D:\Data\" ' ini tujuan untuk paste folder yang di copy
Set CFO = CreateObject("Scripting.FileSystemObject")

If Not CFO.FolderExists(dFolder) Then
CFO.CopyFolder cFolder, dFolder
MsgBox "Folder Sukses di Copy ke Folder Lain", vbExclamation, "Handle Folder Dan File"
Else
MsgBox "Folder Copy sudah tersedia..!!", vbExclamation, "Handle Folder Dan File"
End If
End Sub

• Kode VBA Untuk pindah/Move Folder ke lokasi lain di Expolorer/Partisi. Klik kanan pada CommandButton5 dengan Caption "Move Folder", pilih View Code dan masukkan kode berikut ini 

Private Sub CommandButton5_Click()
Dim CFO
Dim cFolder As String, dFolder As String

cFolder = "E:\Test Folder\" 'Folder Asal
dFolder = "D:\Data\" ' Tujuan Pindah
Set CFO = CreateObject("Scripting.FileSystemObject")

If Not CFO.FolderExists(dFolder) Then
CFO.MoveFolder cFolder, dFolder
MsgBox "Folder Selesai Dipindahkan..!!", vbExclamation, "Handle Folder Dan File"
Else
MsgBox "Folder Yang Dipindahkan Sudah Tersedia..!!", vbExclamation, "Handle Folder Dan File"
End If
End Sub

• Kode VBA Untuk Menghapus Folder di Expolorer/Partisi. Klik kanan pada CommandButton6 dengan Caption "Delete Folder", pilih View Code dan masukkan kode berikut ini

Private Sub CommandButton6_Click()
Dim CFO
Dim cFolder As String

cFolder = "E:\Test Folder" 'Ganti dengan folder yang ingin dihapus
Set CFO = CreateObject("Scripting.FileSystemObject")

If CFO.FolderExists(cFolder) Then
CFO.DeleteFolder cFolder
MsgBox "Folder Selesai Di Hapus..!!", vbExclamation, "Handle Folder Dan File"
Else
MsgBox "Folder Yang Ingin Di Hapus Tidak Di Temukan..!!", vbExclamation, "Handle Folder Dan File"
End If
End Sub

• Kode VBA Untuk Read Only Files File . Klik kanan pada CommandButton7 dengan Caption "Read-Only Files", pilih View Code dan masukkan kode berikut ini

Private Sub CommandButton7_Click()
Dim strSaveFilename As String
Dim oFSO As Object
Dim oFile As Object

sFile = "C:\ExampleFile.xls" 'File yang akan dibuat ReadOnly
'Menulis Objeckt
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.GetFile(FilePath:=sFile)

'Set File agar read-only
oFile.Attributes = 1

'Melepaskan object
If Not oFSO Is Nothing Then Set oFSO = Nothing
If Not oFile Is Nothing Then Set oFile = Nothing
End Sub

• Kode VBA Untuk Copy Semua File Yang Terdapat Dalam Folder ke Folder Lain . Klik kanan pada CommandButton8 dengan Caption "Copy All Files", pilih View Code dan masukkan kode berikut ini

Private Sub CommandButton8_Click()
Dim FSO
Dim sFolder As String
Dim dFolder As String

sFolder = "C:\Temp\" ' Anda bisa mengubah folder asal
dFolder = "D:\Job\" ' Anda bisa mengubah folder tujuan
Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FolderExists(sFolder) Then
MsgBox "Tidak Ditemukan Apapun..!!", vbInformation, "Handle Folder Dan File"
ElseIf Not FSO.FolderExists(dFolder) Then
MsgBox "Folder Tujuan Tidak Di Temukan..!!", vbInformation, "Handle Folder Dan File"
Else
FSO.CopyFile (sFolder & "\*.xl*"), dFolder
MsgBox "Sukses..!! Data Excel Semua Selesai Di COPY..!!", vbInformation, "Handle Folder Dan File"
End If
End Sub

• Kode VBA Untuk Membuka  File Yang Terdapat Dalam Folder. Klik kanan pada CommandButton9 dengan Caption "Opening Files", pilih View Code dan masukkan kode berikut ini

Private Sub CommandButton9_Click()
Dim fdl As FileDialog
Dim FileName As String
Dim FileChosen As Integer

Set fdl = Application.FileDialog(msoFileDialogFilePicker)

'Set Judul Dialog Box,
fdl.Title = "Pilih File Macro"
'Set InitialFile Path
fdl.InitialFileName = "c:\"
'Set Folder yang dilihat
fdl.InitialView = msoFileDialogViewSmallIcons
'Set  filter
fdl.Filters.Clear
fdl.Filters.Add "Excel Macros Files", "*.xlsm"

FileChosen = fdl.Show

If FileChosen <> -1 Then
'Bila tidak da pilihan / Click CANCEL
MsgBox "Anda Tidak Memilih Apapun..!!"
Else
'menampilkan nama file yang dipilih
MsgBox fdl.SelectedItems(1)
End If

FileName = fdl.SelectedItems(1)
'Open file
Workbooks.Open (FileName)
End Sub

• Kode VBA Untuk Customize File or Folder. Klik kanan pada CommandButton10 dengan Caption "Customize File or Folder", pilih View Code dan masukkan kode berikut ini

Private Sub CommandButton10_Click()
Dim fdl As FileDialog
Dim FileChosen As Integer

Set fdl = Application.FileDialog(msoFileDialogFilePicker)

'atur judul dialogbox,
fdl.Title = "Please Select a Excel Macro File"
'Atur Initial File Path
fdl.InitialFileName = "c:\"
'Atur Lihat Folder
fdl.InitialView = msoFileDialogViewSmallIcons
'Atur Filter
fdl.Filters.Clear
fdl.Filters.Add "Excel Macros Files", "*.xlsm"

FileChosen = fdl.Show

If FileChosen <> -1 Then
'Bila tidak dipilih sama sekali / Click CANCEL
MsgBox "Anda Tidak Memilih Apapun", vbInformation, "Handle Folder Dan Files"
Else
'Tampilkan nama file jika dipilih
MsgBox fdl.SelectedItems(1)
End If

End Sub

Selesai..!! Posting yang sangat melelahkan..!! Berharap ada yang nawarin minum Just Segelas di akhir Posting ini..!!

Demikian saja.. semoga kode-kodenya bisa digunakan dalam membangun aplikasi secara mandiri. saya menantikan tawaran pengunjung untuk minum Just..!!!!

Berbagi :