Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Another stab - Directories and documents

Status
Not open for further replies.

Domino2

Technical User
Jun 8, 2008
475
GB
I seem to be going round in circles on this one. I have a basic requirement of starting with a main directory and going through any other directories, subdirectories etc, and collating it all into related tables, combining word document names that are stored in the directories. Have made so many attempts and each time its grown into a headache.

Does anyone have any basic syntax to get me on a road to the end? Thanks
 
What have you tried so far and where in your code are you stuck ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
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
 
How do I deal with "Path not found" I am trying to list any subdirectories of a subdirectory. However becuase (I presume) there is no subdirectory in the subdirectory I get the message "Path not found"

ParseFolder5 MainDir & "\" & SubDir

Sub ParseFolder5(FolderName5 As String)
Dim fso As Object
Dim fld As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(FolderName5)
Call ListFilesAndSubFolders5(fld)
End Sub



 
Why so many procedures ?
I'd use recursion ...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Thanks, if I knew what I was doing I would use recursion but as I started with an initial procedure I carried on building blocks. There must be a simpler process to do what I want. I am trying to search through all folders and subfolders that might exist, together with any files in or within direcotory structure and put all the data into related tables. I have since been tying myself in knots!!
 
Many thanks fneily, I gave that a try and if I can break it up into directories/subdirectories/files to go into tables then at last I'm happier.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top