change modification date for ALL files under a folder

R

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

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
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
John_w said:
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
Click to expand...
Thanks your amazing !
 
Upvote 0
John_w said:
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
Click to expand...
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
Georgiboy said:
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
Click to expand...
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
Georgiboy said:
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
Click to expand...
it works it was the STR path :) thanks
 
Upvote 0
Georgiboy said:
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
Click to expand...
only thing it doesnt do the subfolders but thats okay :)
 
Upvote 0
rawr19911 said:
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.
Click to expand...
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
You must log in or register to reply here.

Similar threads

G
  • Question Question
Modify Single Email in Outlook Drafts subfolder
Replies
1
Views
386
g_speran
G
J
  • Question Question
VBA to List all Folders, Subfolders and files in a directory
Replies
4
Views
3K
Formula11
F
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M
R
  • Solved
Need count of all files under folder with modification date
Replies
3
Views
416
smozgur
smozgur
T
  • Question Question
Printing to PDF use VBA - Was working but now different sheets are different widths
Replies
1
Views
307
Tanquen
T

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

Share this page

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