Any way for VBA to change file modified property

dnickelson

dnickelson

Board Regular
Joined
Oct 30, 2003
Messages
118
Is there any way for VBA to modify file properties directly, as in changing the DateLastModified for a specific file?

I am running a macro that copy contents from a file (one at a time from a large list), modifies the contents and writes it back to the file (actually just deletes the original and creates a file with the same name). The problem is that the files were each originally created on days specific to an incident occurring. The file name contains the date and time of creation, but before modifying the files, I could sort them in descending order by date, but now all the files are modified when the macro runs. I'd like to take the date information I have and directly adjust the Last Modified Date for each file. Possible?
 
Sort by date Sort by votes
Sweet, you're adjustment fixed it. I was pretty sure it was a system time issue, but hadn't thought that simple change would fix it (try the easy things first?). I posted the code I was trying below anyway, until then, maybe someday we'll pick up the metric system and you guys will start writing the date out correctly! :wink:

thanks again. I'll try putting the function to good use.
(In case you were wondering what it's for, I have a script that pulls an attachment out of outlook, saves it to a directory, then excel opens it, does some formatting and resaves it. I wanted the the modified time to match when the email was sent for sorting purposes, but the excel formatting changes the time to when the file was run. I'll be using your code to set the mod time based on the file name (which also contains the date). Thanks much.
-Dan



Option Explicit

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime 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
wMilliseconds As Integer
End Type

Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Declare 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 Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Function AdjustFileTime(strFilePath As String, WriteFileDate As Date, CreateFileDate As Date, AccessFileDate As Date) As Long
Dim NewWriteDate As Date, NewCreateDate As Date, NewAccessDate As Date, lngHandle As Long

Dim udtWriteTime As FILETIME
Dim udtCreateTime As FILETIME
Dim udtAccessTime As FILETIME

Dim udtSysCreateTime As SYSTEMTIME
Dim udtSysAccessTime As SYSTEMTIME
Dim udtSysWriteTime As SYSTEMTIME

Dim udtLocalCreateTime As FILETIME
Dim udtLocalAccessTime As FILETIME
Dim udtLocalWriteTime As FILETIME

NewCreateDate = Format(CreateFileDate, "MM-DD-YY HH:mm:SS")
NewAccessDate = Format(AccessFileDate, "MM-DD-YY HH:mm:SS")
NewWriteDate = Format(WriteFileDate, "MM-DD-YY HH:mm:SS")

With udtSysCreateTime
.wYear = Year(NewCreateDate)
.wMonth = Month(NewCreateDate)
.wDay = Day(NewCreateDate)
.wDayOfWeek = Weekday(NewCreateDate) - 1
.wHour = Hour(NewCreateDate)
.wMinute = Minute(NewCreateDate)
.wSecond = Second(NewCreateDate)
.wMilliseconds = 0
End With

With udtSysAccessTime
.wYear = Year(NewAccessDate)
.wMonth = Month(NewAccessDate)
.wDay = Day(NewAccessDate)
.wDayOfWeek = Weekday(NewAccessDate) - 1
.wHour = Hour(NewAccessDate)
.wMinute = Minute(NewAccessDate)
.wSecond = Second(NewAccessDate)
.wMilliseconds = 0
End With

With udtSysWriteTime
.wYear = Year(NewWriteDate)
.wMonth = Month(NewWriteDate)
.wDay = Day(NewWriteDate)
.wDayOfWeek = Weekday(NewWriteDate) - 1
.wHour = Hour(NewWriteDate)
.wMinute = Minute(NewWriteDate)
.wSecond = Second(NewWriteDate)
.wMilliseconds = 0
End With
Dim ret As Long
ret = SystemTimeToFileTime(udtSysCreateTime, udtLocalCreateTime)
If ret <> 1 Then Err.Raise GetLastError
ret = LocalFileTimeToFileTime(udtLocalCreateTime, udtCreateTime)
If ret <> 1 Then Err.Raise GetLastError

ret = SystemTimeToFileTime(udtSysAccessTime, udtLocalAccessTime)
If ret <> 1 Then Err.Raise GetLastError
ret = LocalFileTimeToFileTime(udtLocalAccessTime, udtAccessTime)
If ret <> 1 Then Err.Raise GetLastError

ret = SystemTimeToFileTime(udtSysWriteTime, udtLocalWriteTime)
If ret <> 1 Then Err.Raise GetLastError
ret = LocalFileTimeToFileTime(udtLocalWriteTime, udtWriteTime)
If ret <> 1 Then Err.Raise GetLastError

lngHandle = CreateFile(strFilePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lngHandle = -1 Then Err.Raise 53

' create, access, write
ret = SetFileTime(lngHandle, udtCreateTime, udtAccessTime, udtWriteTime)
'ret = SetFileTime(lngHandle, , , udtWriteTime)
CloseHandle lngHandle
AdjustFileTime = 1
If ret <> 1 Then Err.Raise GetLastError

End Function

Sub foo()
Dim i As Long
Dim wrtfile As Variant
Dim crtfile As Variant
Dim accessfile As Variant
Dim fil As String
Dim fs, f, s

On Error GoTo ERR_HANDLER
'WriteFile CreateFile AccessFileDate
'wrtfile = "12/12/2004 20:09:26"
'crtfile = "11/12/2004 20:10:26"
'accessfile = "10/12/2004 20:11:26"
fil = "c:\excel\test.txt"

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fil)
crtfile = f.DateCreated
accessfile = f.DateLastAccessed
wrtfile = Sheets("Sheet1").Cells(3, 2).Value

i = AdjustFileTime(fil, CDate(wrtfile), CDate(crtfile), CDate(accessfile))
Exit Sub
ERR_HANDLER:
MsgBox Err.Description
On Error GoTo 0
End Sub
 
Upvote 0

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Someone linked me to this thread so in case an expert has this flagged for notification, my problem is as below. I need to determine last User access but everything I have tried resets it.

I need to retain the last accessed data from a user perspective. Everything I have seen and/or tried to this point including the Scripting.FileSystemObject and API code resets the LastAccessed property because the file is "opened" to read the properties. Is there any way to retrieve the LastAccessed property without resetting it?

Thanks!
 
Upvote 0
No, that is not true. The date of last access is not changed if the file attributes are queried. I just checked the output of the Directory List add-in (http://www.tushar-mehta.com/excel/software/dirlist/index.html). It uses FileSystemObject and the property f.DateLastAccessed. Also, I am reasonably sure that use of DIR() has the same result.
sbendbuckeye said:
{snip}I need to retain the last accessed data from a user perspective. Everything I have seen and/or tried to this point including the Scripting.FileSystemObject and API code resets the LastAccessed property because the file is "opened" to read the properties. Is there any way to retrieve the LastAccessed property without resetting it?

Thanks!
Click to expand...
 
Upvote 0
Thank you Tusharm! You are correct, I'm not sure why my test data appeared to verify what I posted above. My aplogies to anyone who was mislead by my invalid post.
 
Upvote 0
Hi - I am wondering whether this code could be modified so that it loops through documents in a folder and the user is prompted to enter a new modified date for each document? Thank you for any assistance.

zilpher said:
Hi

Here's some code that will do what you ask. It uses the SetFileTime API. Place this code in your work book and call it as I have shown in the example sub foo:

Code: 
Option Explicit

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime 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
    wMilliseconds As Integer
End Type

Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Declare 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 Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Function AdjustFileTime(strFilePath As String, WriteFileDate As Date, CreateFileDate As Date, AccessFileDate As Date) As Long
Dim NewWriteDate As Date, NewCreateDate As Date, NewAccessDate As Date, lngHandle As Long

Dim udtWriteTime As FILETIME
Dim udtCreateTime As FILETIME
Dim udtAccessTime As FILETIME

Dim udtSysCreateTime As SYSTEMTIME
Dim udtSysAccessTime As SYSTEMTIME
Dim udtSysWriteTime As SYSTEMTIME

Dim udtLocalCreateTime As FILETIME
Dim udtLocalAccessTime As FILETIME
Dim udtLocalWriteTime As FILETIME

NewCreateDate = Format(CreateFileDate, "DD-MM-YY HH:mm:SS")
NewAccessDate = Format(AccessFileDate, "DD-MM-YY HH:mm:SS")
NewWriteDate = Format(WriteFileDate, "DD-MM-YY HH:mm:SS")

With udtSysCreateTime
    .wYear = Year(NewCreateDate)
    .wMonth = Month(NewCreateDate)
    .wDay = Day(NewCreateDate)
    .wDayOfWeek = Weekday(NewCreateDate) - 1
    .wHour = Hour(NewCreateDate)
    .wMinute = Minute(NewCreateDate)
    .wSecond = Second(NewCreateDate)
    .wMilliseconds = 0
End With

With udtSysAccessTime
    .wYear = Year(NewAccessDate)
    .wMonth = Month(NewAccessDate)
    .wDay = Day(NewAccessDate)
    .wDayOfWeek = Weekday(NewAccessDate) - 1
    .wHour = Hour(NewAccessDate)
    .wMinute = Minute(NewAccessDate)
    .wSecond = Second(NewAccessDate)
    .wMilliseconds = 0
End With

With udtSysWriteTime
    .wYear = Year(NewWriteDate)
    .wMonth = Month(NewWriteDate)
    .wDay = Day(NewWriteDate)
    .wDayOfWeek = Weekday(NewWriteDate) - 1
    .wHour = Hour(NewWriteDate)
    .wMinute = Minute(NewWriteDate)
    .wSecond = Second(NewWriteDate)
    .wMilliseconds = 0
End With
Dim ret As Long
ret = SystemTimeToFileTime(udtSysCreateTime, udtLocalCreateTime)
If ret <> 1 Then Err.Raise GetLastError
ret = LocalFileTimeToFileTime(udtLocalCreateTime, udtCreateTime)
If ret <> 1 Then Err.Raise GetLastError

ret = SystemTimeToFileTime(udtSysAccessTime, udtLocalAccessTime)
If ret <> 1 Then Err.Raise GetLastError
ret = LocalFileTimeToFileTime(udtLocalAccessTime, udtAccessTime)
If ret <> 1 Then Err.Raise GetLastError

ret = SystemTimeToFileTime(udtSysWriteTime, udtLocalWriteTime)
If ret <> 1 Then Err.Raise GetLastError
ret = LocalFileTimeToFileTime(udtLocalWriteTime, udtWriteTime)
If ret <> 1 Then Err.Raise GetLastError

lngHandle = CreateFile(strFilePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
If lngHandle = -1 Then Err.Raise 53

'                                 create,      access,      write
ret = SetFileTime(lngHandle, udtCreateTime, udtAccessTime, udtWriteTime)
CloseHandle lngHandle
AdjustFileTime = 1
If ret <> 1 Then Err.Raise GetLastError

End Function

Sub foo()
Dim i As Long
On Error GoTo ERR_HANDLER
i = AdjustFileTime("c:\test.txt", CDate("12/12/2004 20:09:26"), CDate("11/12/2004 20:09:26"), CDate("10/12/2004 20:09:26"))
Exit Sub
ERR_HANDLER:
MsgBox Err.Description
On Error GoTo 0
End Sub

There doesn't seem to be a lot of point in adjusting the LastAccess time as it always sets to the time you run the code (makes sense I s'pose). I don't experience this feature on my Win2k box at work, here at home it's XP so maybe it's that; you could always adjust the system clock first. Not sure but I'm off to bed :D

HTH
Click to expand...
 
Upvote 0
Thank you Zilpher! Your solution works. And I met a similar problem that dnickelson met. Then your fix works. I just need to change it to "YY-MM-DD".
zilpher said:
I haven't been able to recreate the problem you speak of but I suspect it's down to the file date system on our two machines. Being a limey Brit I use dd/mm/yyyy whereas as you are in the states you probably use mm/dd/yyyy.

I tried using the 'wrong' file system for my machine but didn't get the same problem, but I would suggest you try changing the AdjustFileTime function thus:

Code: 
'NewCreateDate = Format(CreateFileDate, "DD-MM-YY HH:mm:SS")
'NewAccessDate = Format(AccessFileDate, "DD-MM-YY HH:mm:SS")
'NewWriteDate = Format(WriteFileDate, "DD-MM-YY HH:mm:SS")
NewCreateDate = Format(CreateFileDate, "MM-DD-YY HH:mm:SS")
NewAccessDate = Format(AccessFileDate, "MM-DD-YY HH:mm:SS")
NewWriteDate = Format(WriteFileDate, "MM-DD-YY HH:mm:SS")

I am not confident this will work as a date is a date and then the OS sorts out the display.

Can you post your code?

If I could recreate it it'd be easier to fix, hope this helps

Z
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Vba code to open all excel files along with excel name and date modified and data inside the excel
Replies
0
Views
112
suyogpat
S
J
  • Question
Forced to discard digital signature after opening and immediately saving an Macro-Enabled Excel file
Replies
0
Views
140
JDCreate
J
S
  • Solved
Modify the code to save files in xlsx format
Replies
4
Views
96
sofas
S
H
  • Question
Macro to move csv files within-subfolder to folder "Old Templates"
Replies
2
Views
403
howard
H
F
  • Solved
VBA to open all files in a folder, put the file's name in a cell and copy it to another opened workbook
Replies
5
Views
174
feni1388
F

Forum statistics

Threads
1,215,755
Messages
6,126,682
Members
449,328
Latest member
easperhe29

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