CODEWITHSUNDEEP
excelvba
10101
10101

Reputation: 2412

Ensure that file on network drive is up to date

My target is:

  1. Copy file
  2. Ensure that it is copied
  3. Ensure that file on network drive has been updated = date modified is today
  4. If it is not up to date throw an error and proceed to ErrorHandler

Current problem is (I guess) that it somehow goes straight for checking for date modified without taking in account the timer. So I am getting an error message all the time. If I remove part for date modified checking, everything works fine.

Here is my current code:

Sub CopyFile()

On Error GoTo ErrorHandler

            Dim fso As Object
            Set fso = VBA.CreateObject("Scripting.FileSystemObject")

            Dim FileIsHere: FileIsHere = "L:\15\File.CSV"
            Dim PasteItHere: PasteItHere = "C:\temp\"

            Dim ChechDateFile: ChechDateFile = "C:\temp\File.CSV"
            Dim dateLastModified: dateLastModified = fso.GetFile(ChechDateFile).dateLastModified
            Dim DateNow: DateNow = Now()

            'MsgBox (Day(DateNow) & "." & Month(DateNow) & "." & Year(DateNow))
            'MsgBox (Day(dateLastModified) & "." & Month(dateLastModified) & "." & Year(dateLastModified))

            Call fso.CopyFile(FileIsHere, PasteItHere, True)

            Application.Wait (Now + TimeValue("0:00:15"))

            If Day(DateNow) & "." & Month(DateNow) & "." & Year(DateNow) <> Day(dateLastModified) & "." & Month(dateLastModified) & "." & Year(dateLastModified) Then

            'On Error Resume Next
            MsgBox 1 / 0

            Else

            End If

ErrorHandler:

' Send an email message with error

End Sub

After running this script: Files is not modified, I am receiving an error message.

Error message is from errorhandler. Date of file modified is different, even if it is copied. Then IF is true and code goes to MsgBox 1 / 0. Looks like timer does not work?

EDIT:

I don't have any errors in the code, also after commenting out 

On Error GoTo ErrorHandler

I think the problem was just in the logic of the code. I have made it so now, that first it checks for file "Date modified" on network drive, so it is up to date and is updated TODAY. Then if this statement is correct it does the copy. Otherwise if dates does not match it throws an error and code goes to ErrorHandler

My code:

Sub CopyFile()

On Error GoTo ErrorHandler

            Dim fso As Object
            Set fso = VBA.CreateObject("Scripting.FileSystemObject")

            Dim FileIsHere: FileIsHere = "L:\15\File.CSV"
            Dim PasteItHere: PasteItHere = "C:\temp\"

            Dim ChechDateFile: ChechDateFile = "C:\temp\File.CSV"
            Dim dateLastModified: dateLastModified = fso.GetFile(ChechDateFile).dateLastModified
            Dim DateNow: DateNow = Now()

            If Day(DateNow) & "." & Month(DateNow) & "." & Year(DateNow) <> Day(dateLastModified) & "." & Month(dateLastModified) & "." & Year(dateLastModified) Then

            'On Error Resume Next
            MsgBox 1 / 0

            Else

               Call fso.CopyFile(FileIsHere, PasteItHere, True)

            End If

ErrorHandler:

' Send an email message with error

End Sub

Upvotes: 1

Views: 61

Answers (1)

Judge
Judge

Reputation: 317

I have a distant memory of Application.Wait being unreliable.

Try using sleep instead and see if that works more reliably.

Put this at the top of your sheet/module:

#If VBA7 Then ' Excel 2010 or later
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#Else ' Excel 2007 or earlier
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#End If

Then use this in your code instead of Application.Wait (Now + TimeValue("0:00:15")):

Sleep 15000

The above Sleep 15000 asks the application to wait for 15,000 milliseconds.

Upvotes: 1

Related Questions