change modification date for ALL files under a folder

rawr19911

Board Regular
Joined
Jan 21, 2020
Messages
91
Office Version
  1. 2016
Is there a VBA macro that can be created to change all modification dates under a path?
example : C:\Users\User\Documents has modification dates dating from 2015-2023 all files are accessed on a monthly bases, instead of going to each file and hitting save since there are 100s of files- and due to retention records everything has to have been modified within a year in order for it to not be auto deleted- a macro that would go in and update as todays date and time.
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
This macro changes the modified date of all files in the specified folder to today at 09:00:00.
VBA Code:
Public Sub Touch_All_Files_In_Folder()

    Dim PScommand As String
    Dim folderPath As String
    Dim newModifiedDateTime As Date
    
    folderPath = "C:\path\to\folder\" 'CHANGE THIS
    newModifiedDateTime = Date + TimeValue("09:00:00")
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    PScommand = "Get-ChildItem """ & folderPath & "*"" | ForEach-Object{$_.LastWriteTime = New-object DateTime " & Format(newModifiedDateTime, "yyyy,mm,dd,hh,nn,ss") & "}"

    CreateObject("Wscript.Shell").Run "powershell.exe -command " & PScommand, windowStyle:=WshHide, waitOnReturn:=True
           
End Sub
 
Upvote 0
This macro changes the modified date of all files in the specified folder to today at 09:00:00.
VBA Code:
Public Sub Touch_All_Files_In_Folder()

    Dim PScommand As String
    Dim folderPath As String
    Dim newModifiedDateTime As Date
   
    folderPath = "C:\path\to\folder\" 'CHANGE THIS
    newModifiedDateTime = Date + TimeValue("09:00:00")
   
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    PScommand = "Get-ChildItem """ & folderPath & "*"" | ForEach-Object{$_.LastWriteTime = New-object DateTime " & Format(newModifiedDateTime, "yyyy,mm,dd,hh,nn,ss") & "}"

    CreateObject("Wscript.Shell").Run "powershell.exe -command " & PScommand, windowStyle:=WshHide, waitOnReturn:=True
          
End Sub
Thanks your amazing !
 
Upvote 0
This macro changes the modified date of all files in the specified folder to today at 09:00:00.
VBA Code:
Public Sub Touch_All_Files_In_Folder()

    Dim PScommand As String
    Dim folderPath As String
    Dim newModifiedDateTime As Date
   
    folderPath = "C:\path\to\folder\" 'CHANGE THIS
    newModifiedDateTime = Date + TimeValue("09:00:00")
   
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    PScommand = "Get-ChildItem """ & folderPath & "*"" | ForEach-Object{$_.LastWriteTime = New-object DateTime " & Format(newModifiedDateTime, "yyyy,mm,dd,hh,nn,ss") & "}"

    CreateObject("Wscript.Shell").Run "powershell.exe -command " & PScommand, windowStyle:=WshHide, waitOnReturn:=True
          
End Sub
Just tried it this morning- its not working when i click run it runs for like 2 seconds and is finish runing- i went to check dates none of the modfication dates has changed.
 
Upvote 0
How about:
VBA Code:
Option Explicit
Private Type FILETIME
    dwLowDate As Long
    dwHighDate As Long
End Type
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMillisecs As Integer
End Type
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_WRITE = &H40000000
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) _
As Long
Private Declare PtrSafe Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function SetFileTime Lib "kernel32" (ByVal hFile As Long, ByVal MullP As Long, ByVal NullP2 As Long, lpLastWriteTime As FILETIME) As Long
Private Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Sub ChangeLastMod()
    Dim StrFile As String
    Dim StrPath As String
    Dim TheDate As String
    Dim lFileHnd As Long
    Dim lRet As Long
    Dim typFileTime As FILETIME
    Dim typLocalTime As FILETIME
    Dim typSystemTime As SYSTEMTIME
    
    StrPath = "C:\Users\jbloggs\Desktop\TEST\" ' path to files to edit
    TheDate = "25/09/2023 10:01:00" ' time and date to edit

    StrFile = Dir(StrPath)
    
    Do While Len(StrFile) > 0
        With typSystemTime
            .wYear = Year(TheDate)
            .wMonth = Month(TheDate)
            .wDay = Day(TheDate)
            .wDayOfWeek = Weekday(TheDate) - 1
            .wHour = Hour(TheDate)
            .wMinute = Minute(TheDate)
            .wSecond = Second(TheDate)
        End With
        lRet = SystemTimeToFileTime(typSystemTime, typLocalTime)
        lRet = LocalFileTimeToFileTime(typLocalTime, typFileTime)
        lFileHnd = CreateFile(StrPath & StrFile, GENERIC_WRITE, _
            FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, _
            OPEN_EXISTING, 0, 0)
        lRet = SetFileTime(lFileHnd, ByVal 0&, ByVal 0&, _
            typFileTime)
        CloseHandle lFileHnd
        StrFile = Dir
    Loop
End Sub
 
Upvote 0
Solution
How about:
VBA Code:
Option Explicit
Private Type FILETIME
    dwLowDate As Long
    dwHighDate As Long
End Type
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMillisecs As Integer
End Type
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_WRITE = &H40000000
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) _
As Long
Private Declare PtrSafe Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function SetFileTime Lib "kernel32" (ByVal hFile As Long, ByVal MullP As Long, ByVal NullP2 As Long, lpLastWriteTime As FILETIME) As Long
Private Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Sub ChangeLastMod()
    Dim StrFile As String
    Dim StrPath As String
    Dim TheDate As String
    Dim lFileHnd As Long
    Dim lRet As Long
    Dim typFileTime As FILETIME
    Dim typLocalTime As FILETIME
    Dim typSystemTime As SYSTEMTIME
   
    StrPath = "C:\Users\jbloggs\Desktop\TEST\" ' path to files to edit
    TheDate = "25/09/2023 10:01:00" ' time and date to edit

    StrFile = Dir(StrPath)
   
    Do While Len(StrFile) > 0
        With typSystemTime
            .wYear = Year(TheDate)
            .wMonth = Month(TheDate)
            .wDay = Day(TheDate)
            .wDayOfWeek = Weekday(TheDate) - 1
            .wHour = Hour(TheDate)
            .wMinute = Minute(TheDate)
            .wSecond = Second(TheDate)
        End With
        lRet = SystemTimeToFileTime(typSystemTime, typLocalTime)
        lRet = LocalFileTimeToFileTime(typLocalTime, typFileTime)
        lFileHnd = CreateFile(StrPath & StrFile, GENERIC_WRITE, _
            FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, _
            OPEN_EXISTING, 0, 0)
        lRet = SetFileTime(lFileHnd, ByVal 0&, ByVal 0&, _
            typFileTime)
        CloseHandle lFileHnd
        StrFile = Dir
    Loop
End Sub
still isnt working - no errors just not updating either:(
 
Upvote 0
Strange, it was tested on Windows 10 64-bit before sending.

Have you tried refreshing the folder with F5 to see if the date changes?
Does your StrPath end with a \ ?

The code should be updating the 'Date modified' field
 
Upvote 0
Strange, it was tested on Windows 10 64-bit before sending.

Have you tried refreshing the folder with F5 to see if the date changes?
Does your StrPath end with a \ ?

The code should be updating the 'Date modified' field
it works it was the STR path :) thanks
 
Upvote 0
Strange, it was tested on Windows 10 64-bit before sending.

Have you tried refreshing the folder with F5 to see if the date changes?
Does your StrPath end with a \ ?

The code should be updating the 'Date modified' field
only thing it doesnt do the subfolders but thats okay :)
 
Upvote 0
Just tried it this morning- its not working when i click run it runs for like 2 seconds and is finish runing- i went to check dates none of the modfication dates has changed.
On a different computer? It could be your account privileges not allowing you to run PowerShell commands.

This macro runs the same PowerShell command (with the -recurse option to include files in subfolders) and outputs any PowerShell errors to the VBA immediate window:
VBA Code:
Public Sub Touch_All_Files_In_Folders()

    Dim PScommand As String
    Dim folderPath As String
    Dim newModifiedDateTime As Date
    Dim WShell As Object, WSExec As Object
    Dim PSoutput As Variant, i As Long
    
    folderPath = "C:\path\to\folder\" 'CHANGE THIS
    newModifiedDateTime = Date + TimeValue("09:00:00")
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    PScommand = "Get-ChildItem """ & folderPath & "*"" -recurse | ForEach-Object{$_.LastWriteTime = New-object DateTime " & Format(newModifiedDateTime, "yyyy,mm,dd,hh,nn,ss") & "}"

    Set WShell = CreateObject("Wscript.Shell")
    Set WSExec = WShell.Exec("powershell.exe -command " & PScommand)
    
    PSoutput = Split(WSExec.StdErr.ReadAll, vbCrLf)
    For i = 0 To UBound(PSoutput)
        Debug.Print PSoutput(i)
    Next

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,198
Members
452,616
Latest member
intern444

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