by Shrestha (1 Submission)
Category: Windows System Services
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 5th October 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
