Set Last Modified date & time to preset value on Save or Save As

[slarti]

We have a PLM system that opens an Excel file and uses Save As to save it to a local users machine. The file is used by our CAD system to set geometry, but as it is a save as copy, the CAD system identifies the geometry as being out of date because the Last Modified date of the file is different to the one it expects.

The file is a very simple Excel workbook, with just a table of X,Y&Z coordinates.

One workaround to the problem would seem to be to set the Created and Last Modified dates & times to a fixed value every time the file is saved or saved as. Having combed various sites I have found ways to use Excel to change this value on external files, e.g. http://www.vbaexpress.com/forum/showthread.php?57369-Rename-Files-By-Adding-Last-Modified-Date, but am unsure how to accomplish it within the same file.

Note, there are no traceability issues with my proposal above, as the file has other references to track changes.

Could anyone provide any advice on whether this is possible and how I might go about it?

[Paul_Hossler]

1. Chip always has good stuff

'http://www.cpearson.com/excel/FileTimes.htm

2. Really not sure about the different WBs from your post, but possibly some thing like this

2020-04-23.xlm is the 'Master' (#1)

Saves itself as a "Copy of " (#2)

Opens #2 and saves that as "Copy of " without the macros (#3)

Closes #3

Deletes #2

Changes dates on #3 on the disk

Edit:

Decided to go modular and also adjust for Daylight Savings




Option Explicit


Sub SpecialSave()
Dim sSaveXLSM As String, sSaveXLSX As String
Dim iDot As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim iNewDate As Double

Application.ScreenUpdating = False

'remember
Set wb1 = ThisWorkbook

'delete leftover XLSM Copy if there
sSaveXLSM = wb1.Path & Application.PathSeparator & "Copy of " & wb1.Name
Call DeleteFile(sSaveXLSM)

'save copy of this WB
wb1.SaveCopyAs sSaveXLSM

'open copy
Workbooks.Open sSaveXLSM
Set wb2 = ActiveWorkbook

'make XLSX name
iDot = InStrRev(sSaveXLSM, ".")
sSaveXLSX = Left(sSaveXLSM, iDot) & "xlsx"

'delete leftover XLSX copy if there
Call DeleteFile(sSaveXLSX)

'save the copy of Master as XLSX, and close
Application.DisplayAlerts = False
wb2.SaveAs sSaveXLSX, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wb2.Close False
Application.DisplayAlerts = True


wb1.Activate

'delete copy of master
Call DeleteFile(sSaveXLSM)

'update file dates
'http://www.cpearson.com/excel/FileTimes.htm
iNewDate = CLng(DateSerial(Year(Now) - 1, 1, 1)) ' Jan 1 of last year
If IsCurrentlyDaylightTime Then
iNewDate = iNewDate + 1# / 24#
End If
Call SetFileDateTime(sSaveXLSX, iNewDate, FileDateCreate, False)
Call SetFileDateTime(sSaveXLSX, iNewDate, FileDateLastAccess, False)
Call SetFileDateTime(sSaveXLSX, iNewDate, FileDateLastModified, False)


Application.ScreenUpdating = True


End Sub


Private Sub DeleteFile(S As String)
On Error Resume Next
Application.DisplayAlerts = False
Kill S
Application.DisplayAlerts = True
On Error GoTo 0
End Sub

[slarti]

Hi Paul,

Thank you so much for your help.

You're right, Chip does always have good stuff, why didn't I find this myself!

For info, the reference file or workbook is created by one user, then the save as is triggered by the system whenever anyone else opens the CAD data that references it.

I've found one issue with the file when running on my system, in that I get the error message "The code in this project must be updated for use on 64 bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute". Having done a brief bit of reading on this, I've just crudely appended PTrSafe to every "Private Declare Function" in Chip's code, i.e. it's now "Private Declare PtrSafe Function", which seems to work, but is this the correct approach?

One last question, can the sequence be triggered by action of the PLM system opening and using save as to copy the workbook to the local users machine? I'm assuming there would be no problem adding in something along these lines:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
Cancel = True
SpecialSave
End If

End Sub


Thanks again

[Paul_Hossler]

Don't have 64 bit Office to test, but according to the attachment, 2 APIs need tweaks in addition to PtrSafe




Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As LongPtr) As LongPtr
'PHH 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 PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
'PHH Private Declare Function CloseHandle Lib "kernel32" _
' (ByVal hObject As Long) As Long




IIRC it would be because they use 64 bit handles and need LongPtr

Please let me know if here is something that doesn't work so I can update my copy in case I ever get around to going to 64 bits


Not sure about Workbook_BeforeSave -- only one way to find out :)

[slarti]

Hi Paul,

Thanks for getting back so quickly.

The file seems to work fine with just the tweaks I've done to add PTrSafe, but I'll read up on the documentation you've attached. Note I'm a little busy with other deadlines today, so am regrettably going to have to pause on this and pick it up again next week.

The crude addition of the Workbook_BeforeSave didn't work, but again I'll have a look at that next week.

Thanks again and enjoy the weekend.

[slarti]

The save or save as trigger for the macro is easy, I was being stupid :doh:

Simply use this in ThisWorkbook:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)SpecialSave End Sub

[slarti]

Hi Paul,

Having thought about this some more, I believe the sequence of events needs to be different to ensure compatibility with the PLM & CAD systems.

This is the sequence I'd like, but am struggling to get to work:

1. Master file creates a copy of itself as .xlsm (working ok)

2. The Master file runs a macro in the copy file (working ok)

3. The copy file macro closes the Master file (not working)

3. The copy file macro runs the date change (not working)

I think I've just got slightly lost in the logic of wb1 & wb2 once in the copy file!

Is there any chance you point me in the right direction again?

Thank you!

[Paul_Hossler]

1. If you close a WB with a running macro, the macro stops
2. You can only change the time stamps on a closed file

So we have to have a macro workbook that remains open and the file to be updated must be close



So why not just use a macro that

1. Gets the PLM file name
2. Updates the Create/Access/Modified times

Downside is that you have to open (or have access to) this macro, like in PERSONAL.XLSM



Option Explicit


Sub UpdateTimestamps()
Dim sPLM As String
Dim iNewDate As Double

'get the PLM file name
sPLM = Application.GetOpenFilename("PLM Files, *.xlsx")
If sPLM = "False" Then Exit Sub


'you never said the rule for picking a new date
'http://www.cpearson.com/excel/FileTimes.htm
iNewDate = CLng(DateSerial(Year(Now) - 1, 1, 1)) ' Jan 1 of last year
If IsCurrentlyDaylightTime Then
iNewDate = iNewDate + 1# / 24#
End If


'update file dates
Call SetFileDateTime(sPLM, iNewDate, FileDateCreate, False)
Call SetFileDateTime(sPLM, iNewDate, FileDateLastAccess, False)
Call SetFileDateTime(sPLM, iNewDate, FileDateLastModified, False)
End Sub

[slarti]

Hi Paul,

Thanks again. Your code works, but only with manual intervention of the user. Sadly and perhaps the bit that I didn't adequately convey, this all needs to happen automatically, as the user doesn't see the Excel file, just the CAD data, i.e. this all needs to happen in the background.

I've therefore tweaked your most recent code to be this:


Sub UpdateTimestamps() Dim sPLM As String
Dim iNewDate As Double

'get the name of the file saved by the PLM system
sPLM = VBA.FileSystem.Dir(ThisWorkbook.Path & "\PLM*.xlsm")
If sPLM = VBA.Constants.vbNullString Then Exit Sub

'close original file
Workbooks(sPLM).Close False


'you never said the rule for picking a new date
'http://www.cpearson.com/excel/FileTimes.htm
iNewDate = CLng(DateSerial(Year(Now) - 1, 1, 1)) ' Jan 1 of last year
If IsCurrentlyDaylightTime Then
iNewDate = iNewDate + 1# / 24#
End If


'update file dates
Call SetFileDateTime(sPLM, iNewDate, FileDateCreate, False)
Call SetFileDateTime(sPLM, iNewDate, FileDateLastAccess, False)
Call SetFileDateTime(sPLM, iNewDate, FileDateLastModified, False)
End Sub

So the name of the original file is now identified and I'm working on the assumption that it can be standardised with a prefix, e.g. "PLM".

I'm using code from the original file to run the UpdateTimestamps code in the copy file, but everything stops when I close the original file.

I've attached the latest file so you can see the whole thing (CallAnotherMacro starts the process off).

Any thoughts as to why everything stops when I close the original file, even though the code appears to be running in the copy file?

By the way, the new dates can be set to any point in time that's convenient, so I'm happy with the way it's working at the moment.

[Paul_Hossler]

1. Does your PLM system really create XLSM files? I find that . . . unusual. CSV or TXT or TDV would be more common

2. There will always have to be some user intervention, if only to open the excel workbook with the time changing macro.


How about this?

In it I assumed that the output of your system was a file with a PLM*.txt, although it could be anything since it doesn't get opened

Workbook Open event calls this macro which re-timestamps PLM*.txt files in the same folder

The only thing a user needs to do it open the file with the macro below

Other than that, I'm stumped -- sorry



Option Explicit


Sub UpdateTimestamps()
Dim sPLM As String
Dim iNewDate As Double
Dim aryPLM() As String
Dim iPLM As Long

'you never said the rule for picking a new date
'http://www.cpearson.com/excel/FileTimes.htm
iNewDate = CLng(DateSerial(Year(Now) - 1, 1, 1)) ' Jan 1 of last year
If IsCurrentlyDaylightTime Then
iNewDate = iNewDate + 1# / 24#
End If


'get the name of the file saved by the PLM system
sPLM = Dir(ThisWorkbook.Path & "\PLM*.txt")

Do While Len(sPLM) > 0
iPLM = iPLM + 1
ReDim Preserve aryPLM(1 To iPLM)
aryPLM(iPLM) = sPLM
sPLM = Dir()
Loop

For iPLM = LBound(aryPLM) To UBound(aryPLM)
'update file dates
Call SetFileDateTime(ThisWorkbook.Path & "\" & aryPLM(iPLM), iNewDate, FileDateCreate, False)
Call SetFileDateTime(ThisWorkbook.Path & "\" & aryPLM(iPLM), iNewDate, FileDateLastAccess, False)
Call SetFileDateTime(ThisWorkbook.Path & "\" & aryPLM(iPLM), iNewDate, FileDateLastModified, False)
Next iPLM


' Application.Quit ' leave commented to test


End Sub