• Home
 · 
• Windows System Services
 · 
• Display List of files for a Drive, Folder and SubFolder

Display List of files for a Drive, Folder and SubFolder

Display List of files for a Drive, Folder and SubFolder

API Declarations


Dim rs, rs1 As DAO.Recordset
Dim db As Database
Dim MyPath, MyFile, MyName, NPath, PPath As String
Dim i, j, iPos, endpos As Integer

'' Create Two Tables tbltmp and tblfile



Rate Display List of files for a Drive, Folder and SubFolder

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

On Error Resume Next

Set db = CurrentDb
Set rsPath = db.OpenRecordset("select * from tbltmp")
MyPath = InputBox("Enter Your Path", "Micro Soft", "C:\", 3000, 2700)
PPath = MyPath

Call Start

End Sub
Public Sub Start()
On Error Resume Next

MyFile = Dir(MyPath, vbDirectory)
Set rsFileName = db.OpenRecordset("SELECT * FROM TBLFILENAME")

While MyFile <> ""

    Set rsPath = db.OpenRecordset("select * from tbltmp")
    MyName = MyPath & MyFile
    
    
    If MyFile = "." Or MyFile = ".." Then
    
    Else
        If (GetAttr(MyName) And vbDirectory) = vbDirectory Then
            Set rs1 = db.OpenRecordset("select * from tbltmp where path = '" & MyName & "'")
            
            If rs1.EOF = True Then
                rsPath.AddNew
                rsPath("path") = MyName
                rsPath.Update
                Call Folder1
            Else
            End If
        
        Else
           rsFileName.AddNew
           rsFileName("file path") = MyPath
           rsFileName("file name") = MyFile
           rsFileName.Update
            
        End If
    End If
    
    If MyFile > "" Then
       MyFile = Dir(, vbDirectory)
    Else
 
    End If

Wend

End Sub
Private Sub Folder1()
On Error Resume Next

Set rsFileName = db.OpenRecordset("SELECT * FROM TBLFILENAME")
MyPath = MyName & "\"
MyFile = Dir(MyPath, vbDirectory)

While MyFile <> ""

    Set rsPath = db.OpenRecordset("select * from tbltmp")
    
    If MyFile = "." Or MyFile = ".." Then
    Else
        MyName = MyPath & MyFile
             
        If (GetAttr(MyName) And vbDirectory) = vbDirectory Then
            Set rs1 = db.OpenRecordset("select * from tbltmp where path = '" & MyName & "'")
            If rs1.EOF = True Then
                rsPath.AddNew
                rsPath("path") = MyName
                rsPath.Update
                Call Folder1
             Else
             End If
         Else
         
            rsFileName.AddNew
            rsFileName("file path") = MyPath
            rsFileName("file name") = MyFile
            rsFileName.Update
       
        End If
     End If
        
        If MyFile > "" Then
         MyFile = Dir(, vbDirectory)
        End If
Wend

iPos = InStr(1, MyPath, "\", vbTextCompare)

j = 0
While iPos <> 0
j = j + 1
iPos = InStr(iPos + 1, MyPath, "\", vbTextCompare)
If iPos > 0 Then
i = iPos
End If
Wend

If j > 2 Then
    NPath = Left$(MyPath, i - 1)
    
    iPos = InStr(1, NPath, "\", vbTextCompare)
    
    While iPos <> 0
        iPos = InStr(iPos + 1, NPath, "\", vbTextCompare)
        If iPos > 0 Then
        i = iPos
        End If
    Wend
        MyPath = Left$(NPath, i)
 Else
MyPath = PPath
End If
Call Start

End Sub