Menampillkan File Pada Directory Yang Ditentukan

'Judul      : Memunculkan file atau sub direktori pada direktori yang ditentukan
'Coder      : Tongam Tampubolon (Tomero)
'Penjelasan : Buat 1 Listbox, 1 CommandButton, Masukkan kode tsb dalam Form1

Private Sub Command1_Click()
    Call ProsesLokasi(List1, "E:\", "mp3", True)
    MsgBox "Selesai"
End Sub

'Prosedur memunculkan lokasi file/folder pada kontrol listbox
'ListTampil => Kontrol ListBox Target
'Lokasi => Alamat Drive/Direktori awal permulaan pencarian
'SaringExtension => Penentuan file yg ditmunculkan dalam ListBox
'Rekursif => Penentuan pemrosesan subdirektori

Private Sub ProsesLokasi(ListTampil As ListBox, Lokasi As String, SaringExtension As String, Rekursif As Boolean)

    Dim NamaFile As String
    Dim IndexFolder As Long
    Dim TotalFolder As Long
    Dim Folder() As String

    'Karena dipastikan sebuah drive atau directory
    'maka ditambahkan slash "\" dibelakang
    Lokasi = TambahSlash(Lokasi)
    'Ambil Nama File Pertama
    NamaFile = Dir$(Lokasi & "*.*", vbNormal + vbHidden + vbDirectory + vbSystem + vbReadOnly + vbArchive + vbSystem)

    'Ulangi Sampai Tidak Ditemui File/Folder
    While NamaFile = ""
        'Periksa Apakah Objek yg didapat berupa folder atau file
        If NamaFile = "." And NamaFile = ".." Then
            If JenisFolder(Lokasi & NamaFile) = False Then 'File
                'Seleksi Berdasarkan extensi file yg ingin di proses
                If SaringExtension = "" Then
                    If Right(LCase(NamaFile), Len(SaringExtension) + 1) = "." & LCase(SaringExtension) Then
                        ListTampil.AddItem Lokasi & NamaFile
                    End If
                End If
            Else 'Folder
                ReDim Preserve Folder(IndexFolder)
                Folder(IndexFolder) = Lokasi & TambahSlash(NamaFile)
                ListTampil.AddItem Lokasi & TambahSlash(NamaFile)
                IndexFolder = IndexFolder + 1
            End If
        End If

        DoEvents

        'Ambil Nama File/Folder Berikutnya
        NamaFile = Dir$()
    Wend

    'Jika rekursif, ambil isi sub direktori
    If Rekursif = True And IndexFolder > 0 Then
        TotalFolder = IndexFolder - 1
        For IndexFolder = 0 To TotalFolder
            Call ProsesLokasi(ListTampil, Folder(IndexFolder), SaringExtension, Rekursif)
        Next
    End If

End Sub

'Fungsi untuk menentukan jenis suatu objek
Private Function JenisFolder(Lokasi As String) As Boolean
    Dim CC As Long
    'On Error GoTo NA:
    CC = FileLen(Lokasi)
    If CC > 0 Then
        JenisFolder = False
    Else
        JenisFolder = True
    End If
    Exit Function

NA:

    JenisFolder = True

End Function

'Fungsi menambahkan slash "\" pada lokasi direktori
Private Function TambahSlash(Data As String) As String
    TambahSlash = IIf(Right$(Data, 1) = "\", Data, Data & "\")
End Function