Results 1 to 7 of 7
  1. #1
    Lounger
    Join Date
    Mar 2002
    Location
    St Albans, Hertfordshire, England
    Posts
    48
    Thanks
    0
    Thanked 0 Times in 0 Posts

    FileSystem Query (Access 2K/Win 2K)

    Hello again folks!

    I am developing a system to manage the files on our network drives - there are a number of aims, but the simplified process is as follows:

    1 - Process the filesystem to return filenames, sizes, modified dates
    2 - Load this data into a temporary table
    3 - Compare temporary table to 'main table' to see if:
    1 - File exists already
    2 - File is a new file
    3 - File in Main table no longer exists (i.e. has been deleted)
    If the file already exists, then nothing happens, apart from updating the date and time/size from latest modification
    If the file exists in Main Table, but not Temporary Data, then delete from Main Table
    If the file exists in Temporary Data but not Main Table, then add to Main Table

    I can get this to work for an individual directory, but I can't work out how to incorporate all subfolders in all directories - can anybody help?

    Code below:
    <pre>Dim fso As New Scripting.FileSystemObject
    Dim fFolder As Scripting.Folder
    Dim retval1 As Integer
    If fso.FolderExists(Me!txtSourceFile.Value) = False Then
    retval1 = MsgBox("The folder selected does not appear to exist!" & vbCrLf & vbCrLf & _
    "Reenter?", vbExclamation + vbYesNo, "Error In Directory Name")
    Select Case retval1
    Case vbYes
    Me!txtSourceFile = Null
    Do Until Len(Me!txtSourceFile) > 2
    Me!txtSourceFile = InputBox("Enter Required Directory", _
    "Error In Directory Name")
    Loop
    Case vbNo
    Exit Sub
    Case Else
    MsgBox "Error in Directory Name Trapped", vbCritical, "System Error"
    Exit Sub
    End Select
    End If
    strFile = Me!txtSourceFile
    Me!txtStatus = "Checking Number of Files in Target Directory..."
    Set fFolder = fso.GetFolder(Me!txtSourceFile)

    Me!txtRecords.Value = fFolder.Files.Count
    Me!txtStatus = "Number of Files in Target Directory Checked!"
    If fFolder.Files.Count = 0 Then
    MsgBox "There are no files in this folder - Cancelling", vbExclamation + vbOKOnly
    Exit Sub
    End If
    Dim blRun As Boolean
    Dim retval As Integer
    retval = MsgBox("The process of loading and validating new data can be very lengthy." _
    & vbCrLf & "Are you sure you wish to continue?", vbCritical + vbYesNo, "WARNING!")
    Select Case retval
    Case vbYes
    blRun = True
    Me!btnCancel.Visible = False
    Me!txtProcessed.Visible = True
    Me!axProgBar.Min = 0
    Me!axProgBar.Max = Me!txtRecords.Value
    Me!axProgBar.Visible = True
    Me!axStatus.Width = 7297
    Case vbNo
    blRun = False
    End Select

    If blRun Then
    Me!txtStatus = "Loading Data..."
    Dim fFile As Scripting.File

    Dim dbs As DAO.Database
    Dim rs As DAO.Recordset
    Set dbs = CurrentDb()
    Dim newcntr As Integer

    ' Delete all records from table
    DoCmd.RunSQL "DELETE * FROM tempDataStore;"

    Set rs = dbs.OpenRecordset("tempDataStore")
    ' Use File System Object to get at folder and files
    Set fFolder = fso.GetFolder(Me!txtSourceFile)
    For Each fFile In fFolder.Files
    rs.AddNew
    rs!Dir = fFile.ParentFolder.Path
    rs!FileName = fFile.Name
    rs!ModTime = Format(fFile.DateLastModified, "HH:nn:ss")
    rs!ModDate = Format(fFile.DateLastModified, "dd/mm/yyyy")
    rs![Size] = fFile.Size
    rs.Update
    newcntr = newcntr + 1
    Me!txtProcessed.Value = newcntr & "/" & fFolder.Files.Count
    Me!axProgBar.Value = newcntr - 1
    Me.Repaint
    Next fFile
    rs.Close

    With Me
    !lblResults.Visible = True
    Set rs = dbs.OpenRecordset("qryLoaded")
    !BoxResults.Visible = True
    !txtLoaded.Value = rs!countoffilename
    !txtLoaded.Visible = True
    Set rs = dbs.OpenRecordset("qrySpace")
    !txtDiskspace = rs!Space
    !axProgBar.Visible = False
    !txtDiskspace.Visible = True
    Set rs = Nothing
    End With
    Me!txtStatus = "Updating file sizes where applicable..."
    DoCmd.OpenQuery "UpdateNewFileSizes"
    Me!txtStatus = "Flagging records which have been deleted..."
    DoCmd.OpenQuery "Files No Longer in Existence - UPDATE DELETE FLAG"
    Me!txtStatus = "Clearing down old records..."
    DoCmd.OpenQuery "Files No Longer in Existence - DELETE"
    Me!txtStatus = "Adding new records to active database..."
    DoCmd.OpenQuery "New Files to Add - ADDED"

    Me!txtStatus.Visible = False
    Me!btnViewData.Visible = True
    End If
    </pre>


  2. #2
    2 Star Lounger
    Join Date
    Nov 2001
    Location
    London, UK, England
    Posts
    116
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FileSystem Query (Access 2K/Win 2K)

    I've written a program that does something similar (trawls through our network finding Access databases and compacts them where possible)....

    To determine if a folder has sub-folders and whether THAT folder has sub-folders, you need to write a recursive call to a 'DetectSubFolders' routine. Here's a couple of routines that do the job, just call the 'GetFiles' routine with the Path to start checking (eg; F and the dictionary object to store the paths in...eg;

    Public Function GetFiles(strPath As String, dctDict As Dictionary) As Boolean

    '// This procedure returns all the files in a directory into
    '// a Dictionary object.

    Dim fsoFileSys As FileSystemObject
    Dim fdrFolder As Folder
    Dim fdrSubFolder As Folder
    Dim i As Integer

    On Error Resume Next

    '// Main file system object
    Set fsoFileSys = New FileSystemObject

    '// Get folder.
    Set fdrFolder = fsoFileSys.GetFolder(strPath)

    If (Err <> 0) Then
    '// Incorrect path.
    GetFiles = False
    GoTo GetFiles_End
    End If

    On Error GoTo 0

    '// Loop through Files collection, adding to dictionary.
    For Each fdrSubFolder In fdrFolder.SubFolders
    dctDict.Add fdrSubFolder.Path, fdrSubFolder.Path
    DetectSubFolders fdrSubFolder, dctDict
    Next fdrSubFolder

    '// Return True if no error occurred.
    GetFiles = True

    GetFiles_End:
    Exit Function

    End Function

    Private Sub DetectSubFolders(fdrFolder As Folder, dctDict As Dictionary)

    ' This procedure returns all the subfolders in a directory into
    ' a Dictionary object.

    Dim fdrSubFolder As Folder
    Dim fdrNewFolder As Folder

    For Each fdrSubFolder In fdrFolder.SubFolders
    dctDict.Add fdrSubFolder.Path, fdrSubFolder.Path
    Set fdrNewFolder = fdrSubFolder
    If fdrNewFolder.SubFolders.Count > 0 Then
    DetectSubFolders fdrNewFolder, dctDict
    End If
    Next

    End Sub

    You will then have a complete collection of folders stored in the dictionary object which you can then iterate through...retrieve the items from the 'Keys' collection of the Dictionary object...

    Dim KeyArray As Variant
    Dim itmElement As Variant

    'Assign returned items to an attay
    KeyArray = dctMainDict.Keys

    For Each itmElement in KeyArray

    '// Your code to process each folder here...

    Next

    Alternativly, you can amend this code to process files as it encounters a new folder. This is a generic example to build a list of folders, hope it helps...

  3. #3
    Lounger
    Join Date
    Mar 2002
    Location
    St Albans, Hertfordshire, England
    Posts
    48
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FileSystem Query (Access 2K/Win 2K)

    Dylan,

    I don't belive I've had the pleasure - but thanks very much indeed for your help - this appears at first reading to do just what I need.

    Kind regards

  4. #4
    Silver Lounger
    Join Date
    Jun 2001
    Location
    Niagara Falls, New York, USA
    Posts
    1,878
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FileSystem Query (Access 2K/Win 2K)

    <P ID="edit" class=small>(Edited by WendellB on 12-Feb-03 10:08. activate link)</P>Hi Chris

    You might get some tips from, Steve Nyberg, filecat - file catalog manager for access

    at

    http://www.mile50.com/access/filecat/index.htm

    HTH

    John

  5. #5
    Lounger
    Join Date
    Mar 2002
    Location
    St Albans, Hertfordshire, England
    Posts
    48
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FileSystem Query (Access 2K/Win 2K)

    John - that was a great piece of advice <img src=/S/thumbup.gif border=0 alt=thumbup width=15 height=15> - and for anybody else who is interested in creating catalogues for both fixed and removable media, then this is a download I would definately recommend (<font color=red>http://www.mile50.com/access/filecat/index.htm</font color=red>) - it needs a few tweaks to make it more user friendly (i.e. adding a status bar/progress bar), but offers a great starting point.

    <img src=/S/ribbon.gif border=0 alt=ribbon width=15 height=15> Thanks again John, and everybody else who volunteered advice!

    Kind regards

  6. #6
    4 Star Lounger
    Join Date
    Feb 2002
    Posts
    537
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: FileSystem Query (Access 2K/Win 2K)

    I am interested in your program but i cannot understand what dictionary is. Also, how could i refer to the path C: ?

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: FileSystem Query (Access 2K/Win 2K)

    A dictionary is an object in the Scripting library that resembles an array, but instead of being indexed by a number 1, 2, 3, ..., it is indexed by a key that can be anything.

    I think this code is a bit too complicated for you to use.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •