VBA or Formula

Tom2020

New Member
Joined
Aug 6, 2021
Messages
14
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
  5. 2010
Platform
  1. Windows
Hello Everyone,
in a spreadsheet, I have a list of files (different file extensions) with only two columns “Filename & Created”

2020_verVabt23_34.doc 10/03/2020 17:25
2012_verVabt23_34.xls 02/11/2013 09:15

Here, my questions:
Is any Formula or VBA to synchronize “Filename & Created”:

If New file name (in the folder) … insert new “Filename & Created” Date in the list

Else

No new Filename, but new Created Date
Update based on filename in the list only the date

Thanks for your help
tom
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Give this a try!
Make sure you update the row and column of your headers, and the folder path of where you want the code to look at files - Do this in the control section of the code (I added comments to guide you on what you need to do)
VBA Code:
Sub Check_Files()
Dim MyRow As Integer
Dim MyClm As Integer
Dim fpath As String
Dim fname As String
Dim i As Integer
Dim lrow As Long


'**********CONTROLS**********

MyRow = 1 'indicate the rows in which your headers "Filename & Created" live
MyClm = 1 'indicate the column # (A=1, B=2, etc...) in which your headers "Filename & Created" start

fpath = "Z:Test\Test\Test1" 'indicate the folder path location of the files you would like the macro to evaluate (Do not add a "\" to the end)

'**********END CONTROLS**********'



fname = Dir(fpath & "\*.*")
Do While fname <> ""
  
    lrow = Cells(Rows.Count, MyClm).End(xlUp).Row 'Last row in the data set
  
    If MyRow = lrow Then 'If there is nothing in the table, then add this record to the first empty row in the table
        Cells(MyRow + 1, MyClm) = fname
        Cells(MyRow + 1, MyClm + 1) = FileDateTime(fpath & "\" & fname)
    End If
  
    For i = MyRow + 1 To lrow 'Loop through all existing files stored in the list to see if there's a match
      
        If fname = Cells(i, MyClm) Then 'If there's a match, update the date and move to next file
            Cells(i, MyClm + 1) = FileDateTime(fpath & "\" & fname)
            GoTo NextFile
        End If

    Next i
  
    'If we get here in the code, then no match was found, this must be a new file
    Cells(lrow + 1, MyClm) = fname
    Cells(lrow + 1, MyClm + 1) = FileDateTime(fpath & "\" & fname)
  
  
NextFile:
    fname = Dir
Loop

End Sub
 
Upvote 0
Give this a try!
Make sure you update the row and column of your headers, and the folder path of where you want the code to look at files - Do this in the control section of the code (I added comments to guide you on what you need to do)
VBA Code:
Sub Check_Files()
Dim MyRow As Integer
Dim MyClm As Integer
Dim fpath As String
Dim fname As String
Dim i As Integer
Dim lrow As Long


'**********CONTROLS**********

MyRow = 1 'indicate the rows in which your headers "Filename & Created" live
MyClm = 1 'indicate the column # (A=1, B=2, etc...) in which your headers "Filename & Created" start

fpath = "Z:Test\Test\Test1" 'indicate the folder path location of the files you would like the macro to evaluate (Do not add a "\" to the end)

'**********END CONTROLS**********'



fname = Dir(fpath & "\*.*")
Do While fname <> ""
 
    lrow = Cells(Rows.Count, MyClm).End(xlUp).Row 'Last row in the data set
 
    If MyRow = lrow Then 'If there is nothing in the table, then add this record to the first empty row in the table
        Cells(MyRow + 1, MyClm) = fname
        Cells(MyRow + 1, MyClm + 1) = FileDateTime(fpath & "\" & fname)
    End If
 
    For i = MyRow + 1 To lrow 'Loop through all existing files stored in the list to see if there's a match
     
        If fname = Cells(i, MyClm) Then 'If there's a match, update the date and move to next file
            Cells(i, MyClm + 1) = FileDateTime(fpath & "\" & fname)
            GoTo NextFile
        End If

    Next i
 
    'If we get here in the code, then no match was found, this must be a new file
    Cells(lrow + 1, MyClm) = fname
    Cells(lrow + 1, MyClm + 1) = FileDateTime(fpath & "\" & fname)
 
 
NextFile:
    fname = Dir
Loop

End Sub
Marvelous, it works.

two last Qs:
If I delete a file, is it possible to set a flag, say in the neighboring cell in the list, to report the file doesn’t exist anymore?
Is it possible to extend e.g. File size and file path?

Thanks for your help I appreciate it very much
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top