This is the code I have so far, it fills four related tables, these being the main directory, any documents in that/those directories, sub direcotories, and any documents in those subdirectories. I am wanting to go one step further and that is to add any subdirectories in a subdirectory, and any files in those sub/sub directories. Any suggestions greatly appreciated
Option Compare Database
Public DREF As String, PREF As String
Public PK As Integer, PK2 As Integer, strsql As String, ag As String, MainDir As String, RootDir As String, SubDir As String
Dim db As DAO.Database, rst As DAO.Recordset, SQL As String, rst2 As DAO.Recordset, rst3 As DAO.Recordset, rst4 As DAO.Recordset
Private Sub Command70_Click()
Set db = CurrentDb()
'GoTo yy
' ' CLEAR tblDirectory TABLE
strsql = "DELETE FROM tblDirectory;"
db.Execute strsql
' ' CLEAR MainDirDocs TABLE
strsql = "DELETE FROM MainDirDocs;"
db.Execute strsql
' ' CLEAR tblSubDir TABLE
strsql = "DELETE FROM tblSubDir;"
db.Execute strsql
' ' CLEAR SubDirectoryDocs TABLE
strsql = "DELETE FROM SubDirectoryDocs;"
db.Execute strsql
yy:
RootDir = "k:\Documents\"
ParseFolder "k:\Documents\"
End Sub
Sub ParseFolder(FolderName As String)
' (1)
Dim fso As Object
Dim fld As Object
' MAIN DIRECTORY NAMES
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderName)
Call ListFilesAndSubFolders(fld)
End Sub
Sub ListFilesAndSubFolders(fld As Object)
Dim fil As Object
Dim sfl As Object
Dim newvar As String
Dim ag As String
Dim bg As String
' (2)
For Each sfl In fld.SubFolders
SQL = "Select * From tblDirectory"
Set rst = db.OpenRecordset(SQL, dbOpenDynaset)
rst.FindFirst "MaindirName = " & Chr(34) & sfl.Name & Chr(34)
If rst.NoMatch = False Then ' Record found
MainDir = RootDir & sfl.Name: PK = rst("DirID") ' Get directory and primary key
Else
MainDir = RootDir & sfl.Name
End If
If rst.NoMatch = True Then
' Not found, so dump main directory data into table
rst.AddNew
rst![MainDirName] = sfl.Name
rst![DocPath] = MainDir
PK = rst("DirID") ' Primary Key generated by added record
rst.Update
Else
' Already in tabels
End If
' During this loop need to get loop of documents within main folders
ParseFolder2 "k:\Documents" & "\" & sfl.Name
' During this loop need to get loop of subdirectories within main folders
ParseFolder3 "k:\Documents" & "\" & sfl.Name
Next sfl
End Sub
Sub ParseFolder2(FolderName2 As String)
' (3)
Dim fso As Object
Dim fld As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderName2)
Call ListFilesAndSubFolders2(fld)
End Sub
Sub ListFilesAndSubFolders2(fld As Object)
' (4)
Dim fil As Object
Dim sfl As Object
' THESE ARE THE DOCUMENTS IN THE INDIVIDUAL MAIN FOLDERS
SQL2 = "Select * From MainDirDocs"
Set rst2 = db.OpenRecordset(SQL2, dbOpenDynaset)
For Each fil In fld.Files
rst2.FindFirst "ReferenceName = " & Chr(34) & fil.Name & Chr(34)
If rst2.NoMatch Then
' Dump data to table
rst2.AddNew
rst2![ReferenceName] = fil.Name
rst2![DocPath] = MainDir
rst2("DirID") = PK
rst2.Update
Else
' Data already in table
' MsgBox "Done already"
End If
Next fil
End Sub
Sub ParseFolder3(FolderName3 As String)
' (5)
Dim fso As Object
Dim fld As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderName3)
Call ListFilesAndSubFolders3(fld)
End Sub
Sub ListFilesAndSubFolders3(fld As Object)
' (6)
Dim fil As Object
Dim sfl As Object
Dim af As String, JP As String
SQL3 = "Select * From tblSubDir"
Set rst3 = db.OpenRecordset(SQL3, dbOpenDynaset)
For Each sfl In fld.SubFolders
rst3.FindFirst "SubDirectoryName = " & Chr(34) & sfl.Name & Chr(34)
SubDir = sfl.Name
If rst3.NoMatch Then
' Dump data to table
rst3.AddNew
rst3![SubDirectoryName] = sfl.Name
JP = sfl.Name
rst3![DocPath] = MainDir & "\" & SubDir
rst3("DirID") = PK
PK2 = rst3("subID")
rst3.Update
Else
' File already in table
End If
' Now extract documents within directory of sfl.Name
ParseFolder4 MainDir & "\" & sfl.Name
' =====================================================
' Now wanting to create list of any sub sub directories of this directory
' =====================================================
Next sfl
End Sub
Sub ParseFolder4(FolderName4 As String)
' (7)
Dim fso As Object
Dim fld As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderName4)
Call ListFilesAndSubFolders4(fld)
End Sub
Sub ListFilesAndSubFolders4(fld As Object)
' (8)
Dim fil As Object
Dim sfl As Object
SQL4 = "Select * From SubDirectoryDocs"
Set rst4 = db.OpenRecordset(SQL4, dbOpenDynaset)
' THESE ARE THE DOCUMENTS IN THE INDIVIDUAL MAIN FOLDERS
For Each fil In fld.Files
rst4.FindFirst "SubDirectoryDocname = " & Chr(34) & fil.Name & Chr(34)
If rst4.NoMatch Then
' Dump data to table
rst4.AddNew
rst4![SubDirectoryDocname] = fil.Name & " TT"
rst4![DocPath] = MainDir & "\" & SubDir
rst4("SubID") = PK2
rst4.Update
Else
' Documents in table
End If
Next fil
End Sub
