vba to change DateLastModified of 5 files to be now, now +2 seconds ... thru now + 8 second

I sometimes have a directory with many related files which are in a particular order. I name them so that an alpha sort gives me the best view. But, sometimes I also want thee datelastmodified to also be sequential.  For example

mod date     filename
5:05:13    Att 00 the answer to your question.doc
5:05:15    att 01.xls backup summary.xls
5:05:17    att 02.xlsx backup detail.xlsx
5:05:19    att 03 signed contract.pdf
5:05:21    att 04 original quote.pdf

So, I tried the following vba program, which almost works but gives slightly random results.   It seems like windows lastmodifieddate is an approximation of the actual update time. The file dates ended up like this
5/28/2015 5:03:24 PM  < time of actual update was perfect. 2 seconds after each update
5/28/2015 5:03:26 PM
5/28/2015 5:03:28 PM
5/28/2015 5:03:30 PM
5/28/2015 5:03:32 PM
5/28/2015 5:03:35 PM
5/28/2015 5:03:37 PM
5/28/2015 5:03:39 PM
5/28/2015 5:03:41 PM
 ==== results ====
5/28/2015 3:59:07 PM
5/28/2015 3:59:07 PM < time of date datelastmodified is wrong.  notice dups
5/28/2015 3:59:39 PM < notice very big jump in seconds.
5/28/2015 3:59:45 PM  
5/28/2015 3:59:45 PM  < notice dups
5/28/2015 3:59:51 PM
5/28/2015 3:59:57 PM
5/28/2015 4:00:03 PM

Does anybody have any idea of how to make the following code work?  By the way, I do NOT want code that can change the file to an arbitrary date in the past.  I was a former auditor for an international accounting firm, so I kind of dislike that kind of code.

Sub UpdateOutlook()

Dim p As Integer, q As Integer
    Dim filename As String
    filename = "C:\Users\bob.berke\AppData\Roaming\Microsoft\Outlook\VbaProject.OTM"
    filename = InputBox("enter filename", , filename)
    If StrPtr(filename) = StrPtr(vbNullString) Then Exit Sub
    filename = Replace(filename, """", "")
    Open filename For Binary As #1
    Get #1, 1, p
    On Error Resume Next
    Put #1, 1, p
    
    If err <> 0 Then
        MsgBox "Please close C:\Users\bob.berke\AppData\Roaming\Microsoft\Outlook\VbaProject.OTM"
        Close #1
        Exit Sub
    End If
    Close #1
    If InStr(1, filename, ".otm", 1) > 0 Then MsgBox "Date Modified has been set to Now() for VbaProject.otm" _
    & vbCrLf & vbCrLf & "Did your remember to drop VBA reference to 'Micro Office 14.0 Object Library'?"
End Sub
Sub modfiles()
' this routine will change the update date and time so that each file is updated 2 seconds after the previous file
Dim filename As Variant
Dim p As Integer, cnt As Long, anames()
filename = Dir("c:\keepempty\att*")
Do While filename <> ""
    cnt = cnt + 1
    ReDim Preserve anames(1 To cnt)
    anames(cnt) = filename
    filename = Dir()
Loop

' Call bubblesort(anames)  temporarily comment out this the bubblesort to avoid overcomplicating this EE question

For Each filename In anames
    Debug.Print now() & " " & filename
    Open filename For Binary As #1
    Get #1, 1, p
   ' On Error Resume Next
    Put #1, 1, p
    Close #1
    DoEvents  ' desparate attempt to fix things
    Sleep 2000
    DoEvents  ' desparate attempt to fix things
Next
Debug.Print " ==== results ===="
Dim fso As New FileSystemObject, file As file

' show the results
For Each file In fso.GetFolder("c:\keepempty").Files
    Debug.Print file.DateLastModified & "    " & file.name
Next

Exit Sub

End Sub

Open in new window

LVL 5
rberkeConsultantAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David Johnson, CD, MVPOwnerCommented:
between each file change sleep 2 seconds and don't worry if the file date is > 2 seconds later.
0
rberkeConsultantAuthor Commented:
That does not make any sense.   line 45 says Sleep 2000 milliseconds.  What are you suggesting I change it to?
0
David Johnson, CD, MVPOwnerCommented:
Sorry I missed that line. mea culpa
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

David Johnson, CD, MVPOwnerCommented:
Instead of reading a byte and then writing the byte back simply set the modified date time
Set objShell = CreateObject("Shell.Application")
Set objFolder =   objShell.NameSpace(filepath")
Set objFolderItem =  objFolder.ParseName(filename)
objFolderItem.ModifyDate = Now  
Sleep 2000
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
rberkeConsultantAuthor Commented:
dave, exactly what I needed except I dropped the Sleep entirely.  The last 2 lines now show

objFolderItem.ModifyDate = Now + cnt/24/60/60 ' add 2 seconds for each file
cnt = cnt + 2
0
rberkeConsultantAuthor Commented:
here is my final code which uses previously written routines ClipPasteFiles and BubbleSort.

Sub modFiles()

' this routine will change the update date and time so that each file is updated 1 seconds after the previous file

' 1) Open explorer and select the files you want updated.
' 2) Copy them to the clipboard using Control C
' 3) call ModFiles

Dim objshell As Object, objFolder, objItem, objFolderItem As FolderItem2, cnt, anames() As String, fullName, fileName, filePath

anames = clipPasteFiles()
Call bubble(anames) ' sort them alphabetically

For Each fullName In anames
    
    filePath = Left(fullName, InStrRev(fullName, "\") - 1)
    fileName = Mid(fullName, InStrRev(fullName, "\") + 1)
    
    If objshell Is Nothing Then
        Set objshell = CreateObject("Shell.Application")
        Set objFolder = objshell.Namespace(filePath)
    End If
    Set objFolderItem = objFolder.ParseName(fileName)
    objFolderItem.ModifyDate = now + cnt / 24 / 3600
    cnt = cnt + 1
Next

Exit Sub

End Sub

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.