Results 1 to 10 of 10
  1. #1
    Sarge is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Sep 2021
    Posts
    4

    Loop through directory to find files

    I have 2 tables in a DB.



    Table 1 list of directories
    Table 2 destination

    I would like to have VBA loop through all the directories (and subfolders) in Table 1 and identify all files with a modified date of 2/12/2021.

    As it identifies the files I would like it to insert them into Table 2.

    Can anyone get me started on this?

    Thanks in advance!

  2. #2
    Micron is offline Virtually Inert Person
    Windows 10 Access 2016
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  3. #3
    kd2017 is offline Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    1,142
    I didn't know this was cross posted and already answered but since I went to the trouble here is my take on it. Keep in mind this was 'to get you started' per request, you would need to modify the HandleFile() sub to use the correct SQL. To use you would call the TraversePath sub and give at a directory like in my TEST() sub. I would probably rename some things and tidy up too... i pulled most of this together using code found on the interwebs, sources in the comments.

    Code:
    Sub TEST()
        TraversePath "C:\Users\Kyle\Downloads\7i96\7i96\configs\hostmot2\"
    End Sub
    
    Sub HandleFile(dir As String, filename As String)
    On Error GoTo ErrHandler
        Dim fullPath As String
        Dim modDate As Date
        Dim qry As String
        Dim testDate As Date
        
        fullPath = dir & filename
        
        ' the date we want to compare the file against
        testDate = DateSerial(2021, 2, 12)
        
        If Not FolderExists(fullPath) Then 'if this is a directory then skip
            modDate = FileDateTime(fullPath)
            If DateSerial(Year(modDate), Month(modDate), Day(modDate)) = testDate Then
                
                'create a query to insert this data into your table
                qry = "INSERT INTO detsination_table_name_here (field1, field2, ..., fieldN) VALUES (val1, val2, ..., valN);"
                
                'execute the insert
                CurrentDb.Execute qry, dbFailOnError
                
            End If
        End If
        
    ExitHandler:
        Exit Sub
    
    ErrHandler:
        MsgBox Err.Description, , "Error #" & Err.Number
        Resume ExitHandler
    End Sub
    
    'https://analystcave.com/vba-dir-function-how-to-traverse-directories/
    Sub TraversePath(path As String)
        Dim currentPath As String, directory As Variant
        Dim dirCollection As Collection
        Set dirCollection = New Collection
        
        currentPath = dir(path, vbDirectory)
        
        'Explore current directory
        Do Until currentPath = vbNullString
            'Debug.Print currentPath
            HandleFile path, currentPath
            If Left(currentPath, 1) <> "." And _
                (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
                dirCollection.Add currentPath
            End If
            currentPath = dir()
        Loop
        
        'Explore subsequent directories
        For Each directory In dirCollection
            'Debug.Print "---SubDirectory: " & directory & "---"
            TraversePath path & directory & "\"
        Next directory
    End Sub
    
    
    
    
    'http://allenbrowne.com/func-11.html
    Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
        'Purpose:   Return True if the file exists, even if it is hidden.
        'Arguments: strFile: File name to look for. Current directory searched if no path included.
        '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
        'Note:      Does not look inside subdirectories for the file.
        'Author:    Allen Browne. http://allenbrowne.com June, 2006.
        Dim lngAttributes As Long
    
        'Include read-only files, hidden files, system files.
        lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
    
        If bFindFolders Then
            lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
        Else
            'Strip any trailing slash, so Dir does not look inside the folder.
            Do While Right$(strFile, 1) = "\"
                strFile = Left$(strFile, Len(strFile) - 1)
            Loop
        End If
    
        'If Dir() returns something, the file exists.
        On Error Resume Next
        FileExists = (Len(dir(strFile, lngAttributes)) > 0)
    End Function
    
    Function FolderExists(strPath As String) As Boolean
        On Error Resume Next
        FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
    End Function
    
    Function TrailingSlash(varIn As Variant) As String
        If Len(varIn) > 0 Then
            If Right(varIn, 1) = "\" Then
                TrailingSlash = varIn
            Else
                TrailingSlash = varIn & "\"
            End If
        End If
    End Function
    https://analystcave.com/vba-dir-func...e-directories/
    http://allenbrowne.com/func-11.html

  4. #4
    orange's Avatar
    orange is offline Moderator
    Windows 10 Office 365
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    kd2017,
    Nice. I modified the code slightly to debug.print files modified on a specific date or specific date + a number of days.
    Works well and is relatively fast.

    Code:
    Sub TESTVRS()
    '
    'adjusted to allow user to enter a startDate and range as needed
    10        Dim StartDate As Integer: StartDate = 1
    20        For i = StartDate To StartDate + 4   'check files modified 2021 Feb 1 thru 5
                  Dim checkDate As TempVar
    30            TempVars!checkDate = DateSerial(2021, 2, i)  'assign the date to be checked
    40            TraversePath "C:\Users\jack\Downloads\"
    50            Debug.Print "Traversing Completed for   " & TempVars!checkDate & vbCrLf
    60         Next i
    End Sub
    Traversing Completed for 01-Feb-21

    C:\Users\jack\Downloads\962A3C04-E9E4-4923-B47B-548B5B61424E.pdf 02-Feb-21
    Traversing Completed for 02-Feb-21

    C:\Users\jack\Downloads\MVPIMG_1599.JPG 03-Feb-21
    Traversing Completed for 03-Feb-21

    Traversing Completed for 04-Feb-21

    C:\Users\jack\Downloads\learn_data_modelling_by_ex ample_pt_2_intermediate_level.pdf 05-Feb-21
    Traversing Completed for 05-Feb-21

  5. #5
    Sarge is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Sep 2021
    Posts
    4
    Sorry about cross posting this. Thank you for responding though. I tried tweaking this accordingly. I can make it work to some extent. However in this form I am getting "Run-time error '3061'. Too few parameters. Expected 1." What variable should I be passing the sql statement?

    Code:
    Sub TEST()    TraversePath "C:\Users\wdsargent\Desktop\"
    End Sub
    
    
    Sub HandleFile(dir As String, filename As String)
    On Error GoTo ErrHandler
        Dim fullPath As String
        Dim modDate As Date
        Dim qry As String
        Dim testDate As Date
        
        fullPath = dir & filename
        
        ' the date we want to compare the file against
        testDate = DateSerial(2021, 8, 24)
        
        If Not FolderExists(fullPath) Then 'if this is a directory then skip
            modDate = FileDateTime(fullPath)
            If DateSerial(Year(modDate), Month(modDate), Day(modDate)) = testDate Then
                
                'create a query to insert this data into your table
                qry = "INSERT INTO Table3 (Cucumber) VALUES (fullpath);"
                
                'execute the insert
                CurrentDb.Execute qry, dbFailOnError
                
            End If
        End If
        
    ExitHandler:
        Exit Sub
    
    
    ErrHandler:
        MsgBox Err.Description, , "Error #" & Err.Number
        Resume ExitHandler
    End Sub
    
    
    'https://analystcave.com/vba-dir-function-how-to-traverse-directories/
    Sub TraversePath(path As String)
        Dim currentPath As String, directory As Variant
        Dim dirCollection As Collection
        Set dirCollection = New Collection
        
        currentPath = dir(path, vbDirectory)
        
        'Explore current directory
        Do Until currentPath = vbNullString
            'Debug.Print currentPath
            HandleFile path, currentPath
            If Left(currentPath, 1) <> "." And _
                (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
                dirCollection.Add currentPath
            End If
            currentPath = dir()
        Loop
        
        'Explore subsequent directories
        For Each directory In dirCollection
            'Debug.Print "---SubDirectory: " & directory & "---"
            TraversePath path & directory & "\"
        Next directory
    End Sub
    
    
    
    
    
    
    
    
    'http://allenbrowne.com/func-11.html
    Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
        'Purpose:   Return True if the file exists, even if it is hidden.
        'Arguments: strFile: File name to look for. Current directory searched if no path included.
        '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
        'Note:      Does not look inside subdirectories for the file.
        'Author:    Allen Browne. http://allenbrowne.com June, 2006.
        Dim lngAttributes As Long
    
    
        'Include read-only files, hidden files, system files.
        lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
    
    
        If bFindFolders Then
            lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
        Else
            'Strip any trailing slash, so Dir does not look inside the folder.
            Do While Right$(strFile, 1) = "\"
                strFile = Left$(strFile, Len(strFile) - 1)
            Loop
        End If
    
    
        'If Dir() returns something, the file exists.
        On Error Resume Next
        FileExists = (Len(dir(strFile, lngAttributes)) > 0)
    End Function
    
    
    Function FolderExists(strPath As String) As Boolean
        On Error Resume Next
        FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
    End Function
    
    
    Function TrailingSlash(varIn As Variant) As String
        If Len(varIn) > 0 Then
            If Right(varIn, 1) = "\" Then
                TrailingSlash = varIn
            Else
                TrailingSlash = varIn & "\"
            End If
        End If
    
    End Function

  6. #6
    orange's Avatar
    orange is offline Moderator
    Windows 10 Office 365
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Show us the design of your table "cucumber"?? You'll have to correct the query SQL. You either have a table Table3 or one called Cucumber.

    Post #1 says store results in Table2??

  7. #7
    kd2017 is offline Well, I tried at least.
    Windows 10 Access 2016
    Join Date
    Jul 2017
    Posts
    1,142
    [edit] In addition to orange's point
    You need to use string concatenation to build the sql query to include the value of the full path. This is a string so don't forget quotation marks.

    Code:
    qry = "INSERT INTO Table3 (Cucumber) VALUES (""" & fullpath & """);"
    debug.print qry 'print the sql to the debug window to double check that we built it correctly
    https://www.google.com/search?client...+concatenation

  8. #8
    orange's Avatar
    orange is offline Moderator
    Windows 10 Office 365
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    I created a small routine to create the table. I called it table2sarge

    Code:
    Sub CreateTable2Sarge()
    10        On Error Resume Next
              Dim sqlDrop As String
    20        sqlDrop = "Drop Table Table2Sarge"
    30        CurrentDb.Execute sqlDrop, dbFailOnError
              Dim sqlCreate As String
    40        sqlCreate = "CREATE TABLE Table2Sarge " & _
                  "(EntryID AUTOINCREMENT PRIMARY KEY,filepath varchar(100),ModDate Date );"
    50        CurrentDb.Execute sqlCreate, dbFailOnError
    End Sub
    This gives the fullpath filename and the date last modified.

    This is my Handlefile modification.

    Code:
    Sub HandleFile(dir As String, filename As String)
    10        On Error GoTo ErrHandler
              Dim fullPath As String
              Dim modDate As Date
              Dim qry As String
              Dim testDate As Date
              
    20        fullPath = dir & filename
              
              ' the date we want to compare the file against (year,month,Day)
    30        testDate = TempVars!checkDate   ' DateSerial(2021, 2, 14)
              
    40        If Not FolderExists(fullPath) Then 'if this is a directory then skip
    50            modDate = FileDateTime(fullPath)
    60            If DateSerial(Year(modDate), Month(modDate), Day(modDate)) = testDate Then
    70                Debug.Print fullPath & "   " & testDate
                      'create a table and a query to insert this data into your table if needed
    80                 qry = "INSERT INTO table2Sarge (filepath,moddate) VALUES ('" & fullPath & "','" & testDate & "');"
                      
                      'execute the insert
    90                 CurrentDb.Execute qry, dbFailOnError
                      
    100           End If
    110       End If
              
    ExitHandler:
    120       Exit Sub
    
    ErrHandler:
    130       MsgBox Err.Description, , "Error #" & Err.Number & "  " & Erl
    140       Resume ExitHandler
    End Sub
    And this is the modified TESTVRS as mentioned earlier.

    Code:
    ' ----------------------------------------------------------------
    ' Procedure Name: TESTVRS
    ' Purpose: From accessforums.net   https://www.accessforums.net/showthread.php?t=84428
    'Traverse a path and find files with modified date equal to some specified date
    ' Procedure Kind: Sub
    ' Procedure Access: Public
    ' Author: kd2017 ---Jack/based on accessForums.net thread
    ' Date: 21-Sep-21
    ' ----------------------------------------------------------------
    Sub TESTVRS()
          '
          'adjusted to allow user to enter a startDate and range as needed
    10        Dim StartDate As Integer: StartDate = 1
    20        For i = StartDate To StartDate  ' + 4   'check files modified 2021 June 1 thru 5
                  Dim checkDate As TempVar
    30            TempVars!checkDate = DateSerial(2021, 3, i)  'assign the date to be checked
    40            TraversePath "C:\Users\jack\Downloads\"
    50            Debug.Print "Traversing Completed for   " & TempVars!checkDate & vbCrLf
    60         Next i
    End Sub
    This is my result (immediate window)

    C:\Users\jack\Downloads\Database1_o365.acc_BKUP_20 21-03-01--10-40-18.accdb 01-Mar-21
    Traversing Completed for 01-Mar-21

    and this is the Table2Sarge after the run

    EntryID filepath ModDate
    1 C:\Users\jack\Downloads\Database1_o365.acc_BKUP_20 21-03-01--10-40-18.accdb 01-Mar-21

  9. #9
    Sarge is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Sep 2021
    Posts
    4

    Thumbs up

    That was what I was missing.

    I am still new to VBA I appreciate the assistance!


    Quote Originally Posted by kd2017 View Post
    [edit] In addition to orange's point
    You need to use string concatenation to build the sql query to include the value of the full path. This is a string so don't forget quotation marks.

    Code:
    qry = "INSERT INTO Table3 (Cucumber) VALUES (""" & fullpath & """);"
    debug.print qry 'print the sql to the debug window to double check that we built it correctly
    https://www.google.com/search?client...+concatenation

  10. #10
    pbaldy's Avatar
    pbaldy is offline Who is John Galt?
    Windows XP Access 2007
    Join Date
    Feb 2010
    Location
    Nevada, USA
    Posts
    22,518
    Post 9 was moderated, I'm posting to trigger email notifications.
    Paul (wino moderator)
    MS Access MVP 2007-2019
    www.BaldyWeb.com

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 14
    Last Post: 09-21-2017, 12:10 PM
  2. Replies: 3
    Last Post: 06-22-2015, 02:07 PM
  3. list files in a directory
    By alfrval in forum Access
    Replies: 2
    Last Post: 02-25-2015, 12:46 PM
  4. list all files in a directory
    By snipe in forum Programming
    Replies: 5
    Last Post: 01-21-2014, 12:18 PM
  5. Replies: 6
    Last Post: 06-15-2011, 04:38 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums