to add two hours of timer to move file based on date modified - vba

Question

Some of VBA Experts have helped me a lot and have fixed the code for me which moves one file one at a time but it first moves the oldest file in the folder. However here i have a complex situation which for now not resolving. i.e. I would like to add a timer of two hours i.e. the file should move after two hour.
e.g. If a file named "North_West data" whose modified time is 6:40 PM i would like the code to move it exactly after two hours. Similarly at the next run the next file which has to be moved has filed modified time e.g. 6:50 PM so the VBA code should actually move it exactly after two hours. this means each file should have automatic two hours delay timer in it, i hope i am able to clarify the query.
Function OldestFile(strFold As String) As String
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
For Each File In Folder.Files
If File.DateLastModified < lastFile Then
lastFile = File.DateLastModified: oldF = File.Name
End If
Next
OldestFile = oldF
End Function
Sub MoveOldestFile()
Dim FromPath As String, ToPath As String, fileName As String
FromPath = "E:\Source\"
ToPath = "E:\Destination\"
fileName = OldestFile(FromPath)
If Dir(ToPath & fileName) = "" Then
Name FromPath & fileName As ToPath & fileName
Else
MsgBox "File """ & fileName & """ already moved..."
End If
End Sub
You can check the previously resolved query here
Previous query

Answer 1

Please, try the next way. Basically, it uses a VBScript able to catch file creation event, which sends the created file name and the moment of creation to a workbook which should be open all the time.
Create a VBScript and name it "FolderMonitor.vbs". To do that, please copy the next code in an empty Notepad window:
Dim oExcel, strWB, nameWB, wb
strWB = "C:\Teste VBA Excel\Folder monitor.xlsm" 'use here the path of the waiting workbook!
nameWB = Left(strWB, InStr(StrReverse(strWB), "\") - 1)
nameWB = Right(strWB, Len(nameWB))
Set objExcel = GetObject(,"Excel.Application")
Set wb = objExcel.Workbooks(nameWB)
if wb is nothing then wbscript.quit 'the necessary workbook is not open...
dim strComputer, strDirToMonitor, strTime, objWMIService, colMonitoredEvents, objEventObject, MyFile
strComputer = "."
'# WMI needs two backslashes (\\) as path separator and each of it should be excaped.
'# So, you must use 4 backslashes (\\\\) as path separator!
strDirToMonitor = "C:\\\\test\\\\test" 'use here your path
'# Monitor Above every 10 secs...
strTime = "10"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceOperationEvent WITHIN " & strTime & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=" & Chr(34) & strDirToMonitor & Chr(34) & "'")
Do While True
Set objEventObject = colMonitoredEvents.NextEvent()
Select Case objEventObject.Path_.Class
Case "__InstanceCreationEvent"
MyFile = StrReverse(objEventObject.TargetInstance.PartComponent)
' Get the string to the left of the first \ and reverse it
MyFile = (StrReverse(Left(MyFile, InStr(MyFile, "\") - 1)))
MyFile = Mid(MyFile, 1, Len(MyFile) - 1)
'send the information to the waiting workbook:
objExcel.Application.Run "'" & strWB & "'!GetMonitorInformation", Array(MyFile,Now)
' some other events can be used starting from here...
End Select
Loop
And save it as stated above. But take care to not save it as "FolderMonitor.vbs.txt". In order to avoid that, when saving you should change 'Save as typefrom defaultText documents (.txt)toAll files (.*)`!
In order to make the following code working as it is, you should create a folder named "VBScript" in the folder where the workbook running the code exists and place the above VBScript inside!
Copy the next code in a standard module of a xlsm workbook. In order to be called by the above script, as it is, you should name it "Folder monitor.xlsm":
Option Explicit
Private Const ourScript As String = "FolderMonitor.vbs"
Private Const fromPath As String = "E:\Source\"
Sub startMonitoring()
Dim strVBSPath As String
strVBSPath = ThisWorkbook.Path & "\VBScript\" & ourScript
TerminateMonintoringScript 'to terminate monitoring script, if running..
Shell "cmd.exe /c """ & strVBSPath & """", 0
End Sub
Sub TerminateMonintoringScript()
Dim objWMIService As Object, colItems As Object, objItem As Object, Msg As String
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", "WQL", 48)
For Each objItem In colItems
If objItem.Caption = "wscript.exe" Then
'// msg Contains the path of the exercutable script and the script name
On Error Resume Next
Msg = objItem.CommandLine 'for the case of null
On Error GoTo 0
'// If wbscript.exe runs the monitoring script:
If InStr(1, Msg, ourScript) > 0 Then
Debug.Print "Terminate Wscript process..."
objItem.Terminate 'terminate process
End If
End If
Next
Set objWMIService = Nothing: Set colItems = Nothing
End Sub
Sub GetMonitorInformation(arr As Variant)
'call DoSomething Sub after 2 hours (now IT WILL RUN AFTER 1 MINUTE, for testing reasons...)
'for running after 2 hours you should change "00:01:00" in "02:00:00":
arr(0) = Replace(arr(0), "'", "''") 'escape simple quote (') character'
Application.OnTime CDate(arr(1)) + TimeValue("00:01:00"), "'DoSomething """ & CStr(arr(0)) & """'"
Debug.Print "start " & Now 'just for testing (wait a minute...)
'finaly, this line should be commented.
End Sub
Sub DoSomething(strFileName As String)
Const toPath As String = "E:\Destination\"
If Dir(toPath & strFileName) = "" Then
Name fromPath & strFileName As toPath & strFileName
Debug.Print strFileName & " moved from " & fromPath & " to " & toPath 'just for testing...
Else
MsgBox "File """ & toPath & strFileName & """ already exists in this location..."
End If
End Sub
a. You firstly should run "startMonitoring" Sub. It can be called from the Workbook_Open event.
b. Copy files in the monitored folder and check if they are copied as it should. Note that the code as it is move it after a minute. It is commented to exactly show what and how it can be changed...