When programming, I will use what ever languages/Tools required to get the job done, as long you know? that
using native VBA cannot get the job done.
The following question caught my eye in that I thought it would be interesting to look into.
Q. How can you monitor a directory for changes i.e. new file created or deleted, and enter the details into
a spread sheet? (Well not the exact wording but along those lines.)
For this I looked into WMI ( Microsoft have excellent references here)
Normally I would look into APIs, but this looked easier using scripting.
For some downloads and tools I use, look here
The WMI code to monitor a Dir converted to VBA was not viable as there is a performance hit.
Running it as a vb script was called for, this is where scripting comes in handy.
To cut a long story short, yes it did take a while :) and I won’t bore you with the scripting details, look @ above sites.
1) Get user Directory to Monitor – Use Shell32 object
2) Get Events to monitor (WMI) = 3; Create, Delete, Modify (use some Boolean logic to distinguish)
3) Get XL file to put Data into (Late bound COM) .. default ActiveWorkbook
eg script code
Set MyExcel = GetObject(" & Chr(34) & strThisWorkBook & Chr(34) & ")"
With MyExcel.Worksheets(1)
.Range("A65536").End(-4162).Offset(1, 0).Value = strchange & FileChange
End With
:Note use of constants -4162 =XlDown,
4) vbs uses self terminating code if required i.e. no need to Terminate script process.
(Use Filesystem Object & Wscript engine)
5) Create script file (VBA Print#) -> vbs file
6) Run script file (API of course) rather then Shell (See here why )
7) Monitor every (User determined time) seconds
8) I include a Terminating code incase you run this continuously …. should also place in Workbook close Event.
The following code does all the above ……
Open the Windows Task Manger to see the wscript.exe running.
Then try creating a file …. if you monitor continuously and change a files name
the script will report a Deletion AND Creation Event.
Notes:
Tested Xl2000, Xl2003 WinXP Service pack 2, Norton Antivirus 2005
I cannot vouch it will run on other OS configurations.
Would appreciate any feedback concerning this.
Have I missed something ? Let me know
‘—————————————————————————————
‘ Module : basCreate
‘ DateTime : 3/07/2006 22:02
‘ Author : Ivan F Moala
‘ Purpose : Monitor a Directory for Creation & Deletion of Files
‘ : Creates the vbs code dynamically, allowing user to select Dir & Time
‘ : Xl File to update to, Run continuous or just once
‘ : NB: Changes in files not working ??
‘ : XL2000 & 2003 OS Win XP Service pack 2
‘—————————————————————————————
Private Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal Hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Private Const SW_HIDE As Long = 0
Private Const m_cstrVbsFileName As String = "MonitorChangeInDir.vbs"
‘// Script Host
Private Const m_cWsh As String = "wscript.exe"
Private Const m_cCsh As String = "cscript.exe"
Private m_strScriptRunPath As String
‘// DCM
Sub CreateScriptCode()
Dim intFreeFile As Integer
Dim blnCont As Boolean
Dim strTmp As String
Dim lngRet As Long
Dim strDirToMonitor As String
Dim iSecs As Integer
Dim CreationEvent
Dim MsgRet As Integer
Dim vWorkbookToUpDateTo As Variant
‘// Get Dir to monitor
strDirToMonitor = fnBrowseForFolderShell
If strDirToMonitor = vbNullString Then GoTo UserOptedOut
strTmp = strDirToMonitor
‘// Format is 4 forward slashs
strDirToMonitor = Replace(strDirToMonitor, "", "\\", 1)
‘// What Event do we monitor
CreationEvent = fnGetEventInput
If CreationEvent = 0 Then GoTo UserOptedOut
‘// Get iSecs > specifies that events should be dispatched within iSecs of the actual event occurring.
iSecs = Application.InputBox("Enter time in secs", "Monitor time for: " & strTmp, 10, Type:=1)
If iSecs = 0 Then GoTo UserOptedOut
‘// Where do we up date this to – XL Workbook
vWorkbookToUpDateTo = Application.GetOpenFilename(("XL Files (*.xls), *.xls"), , "Select XL File to put Data into")
‘// If user cancels then default to ThisWorkBook
If TypeName(vWorkbookToUpDateTo) = "Boolean" Then vWorkbookToUpDateTo = ThisWorkbook.FullName
‘// Run continuous or Once
MsgRet = MsgBox("Run script Continuous (Yes) or Once (No) Cancel (Cancel)", vbYesNoCancel, "Script to run")
Select Case MsgRet
Case vbYes: blnCont = True
Case vbNo: blnCont = False
Case vbCancel: GoTo UserOptedOut
End Select
intFreeFile = FreeFile
m_strScriptRunPath = ThisWorkbook.Path & Application.PathSeparator & m_cstrVbsFileName
‘// Open file for output.
Open m_strScriptRunPath For Output As #intFreeFile
Print #intFreeFile, "Dim objFSO"
Print #intFreeFile, "Dim MyExcel"
Print #intFreeFile, "Dim FileChange"
Print #intFreeFile, "Dim strChange"
Print #intFreeFile, "Dim strScript"
Print #intFreeFile, "Dim strComputer"
Print #intFreeFile, ""
Print #intFreeFile, ""
Print #intFreeFile, "strComputer = ""."""
Print #intFreeFile, ""
Print #intFreeFile, "’// Note 4 forward slashes!"
‘// Dir to Monitor
Print #intFreeFile, "strDirToMonitor = " & Chr(34) & strDirToMonitor & Chr(34)
Print #intFreeFile, ""
‘// Monitored every Secs secs
Print #intFreeFile, "strTime = " & Chr(34) & iSecs & Chr(34)
Print #intFreeFile, ""
‘// Where we place the Data – The Excel workbook = Thisworkbook!
Print #intFreeFile, "Set MyExcel = GetObject(" & Chr(34) & vWorkbookToUpDateTo & Chr(34) & ")"
Print #intFreeFile, "Set objWMIService = GetObject(""winmgmts:\"" & strComputer & ""
ootcimv2"")"
Print #intFreeFile, ""
Print #intFreeFile, "Set colMonitoredEvents = objWMIService.ExecNotificationQuery _"
Print #intFreeFile, " (""SELECT * FROM __InstanceOperationEvent WITHIN "" & strTime & "" WHERE "" _"
Print #intFreeFile, " & ""Targetinstance ISA ‘CIM_DirectoryContainsFile’ and "" _"
Print #intFreeFile, " & ""TargetInstance.GroupComponent= "" _"
Print #intFreeFile, " & ""’Win32_Directory.Name="" & Chr(34) & strDirToMonitor & Chr(34) & ""’"")"
Print #intFreeFile, ""
Print #intFreeFile, "Do While True"
Print #intFreeFile, " Set objEventObject = colMonitoredEvents.NextEvent()"
Print #intFreeFile, ""
Print #intFreeFile, " Select Case objEventObject.Path_.Class"
Print #intFreeFile, ""
If (CreationEvent And 2) Then
‘// Creation Event
Print #intFreeFile, " Case ""__InstanceCreationEvent"""
Print #intFreeFile, " MsgBox ""A new file was just created: "" & _"
Print #intFreeFile, " objEventObject.TargetInstance.PartComponent"
Print #intFreeFile, " strChange = " & Chr(34) & "Created:=" & Chr(34)
‘// Run continuous or not?
Print #intFreeFile, " " & IIf(blnCont, "", "Exit Do")
Print #intFreeFile, ""
End If
If (CreationEvent And 1) Then
‘// Deletion Event
Print #intFreeFile, " Case ""__InstanceDeletionEvent"""
Print #intFreeFile, " MsgBox ""A file was just deleted: "" & _"
Print #intFreeFile, " objEventObject.TargetInstance.PartComponent"
Print #intFreeFile, " strChange = " & Chr(34) & "Deleted:=" & Chr(34)
‘// Run continuous or not?
Print #intFreeFile, " " & IIf(blnCont, "", "Exit Do")
Print #intFreeFile, ""
End If
If (CreationEvent And 4) Then
‘// Modification Event > couldn’t get to work
Print #intFreeFile, " Case ""__InstanceModificationEvent"""
Print #intFreeFile, " MsgBox ""A file was just modified: "" & _"
Print #intFreeFile, " objEventObject.TargetInstance.PartComponent"
Print #intFreeFile, " strChange = " & Chr(34) & "Modified:=" & Chr(34)
‘// Run continuous or not?
Print #intFreeFile, " " & IIf(blnCont, "", "Exit Do")
Print #intFreeFile, ""
End If
Print #intFreeFile, " End Select"
Print #intFreeFile, "" & IIf(blnCont, "", "Loop")
Print #intFreeFile, ""
‘//
‘// Write the data to a XL Workbook starting @ A2 SheetIndex 1
‘//
‘Typical format we need to decipher from \IVANPC
ootcimv2:CIM_DataFile.Name="C:\A_BOOK\New Text Document.txt"
Print #intFreeFile, " FileChange = StrReverse(objEventObject.TargetInstance.PartComponent)"
Print #intFreeFile, " ‘// Get the string to the left of the first and reverse it"
Print #intFreeFile, " FileChange = (StrReverse(Left(FileChange, InStr(FileChange, ""\"") – 1)))"
Print #intFreeFile, " FileChange = Mid(FileChange, 1, Len(FileChange) – 1)"
Print #intFreeFile, " With MyExcel.Worksheets(1)"
Print #intFreeFile, " .Range(""A65536"").End(-4162).Offset(1, 0).Value = strchange & FileChange"
Print #intFreeFile, " End With"
‘// Run continuous or not?
Print #intFreeFile, "" & IIf(blnCont, "Loop", "")
‘// If continuous then we don’t need the self terminating code.
‘// Note we DO have the terminating code in the ThisWorkbook_Close routine in case you close down
If blnCont Then GoTo Xit
‘//
‘// Self deleting routine – This script DELETES itself after running!
‘//
Print #intFreeFile, " ‘// Lets delete this script!"
Print #intFreeFile, " Set objFSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")"
Print #intFreeFile, " strScript = Wscript.ScriptFullName"
Print #intFreeFile, " objFSO.DeleteFile (strScript)"
Xit:
Close intFreeFile
‘// Run the script now
lngRet = ShellExecute(0&, "Open", m_strScriptRunPath, 0&, 0&, SW_HIDE)
If lngRet < = 32 Then
MsgBox "Couldn’t Run " & m_strScriptRunPath
Else
MsgBox "Script: " & m_strScriptRunPath & " is running now.", vbInformation, "Script status"
End If
Exit Sub
UserOptedOut:
MsgBox "Script creation cancelled", vbInformation, "Script status"
End Sub
Private Function fnBrowseForFolderShell() As String
‘// Cut down version of Browse for Dir
Dim objShell As Object
Dim objFolder As Variant
Dim strFolderFullPath As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Select a Directory to Monitor", &H20, 0)
If (Not objFolder Is Nothing) Then
‘// NB: If SpecFolder= 0 = Desktop then ….
On Error Resume Next
If IsError(objFolder.Items.Item.Path) Then strFolderFullPath = CStr(objFolder): GoTo GotIt
On Error GoTo 0
‘// Is it the Root Dir?…if so change
If Len(objFolder.Items.Item.Path) > 3 Then
strFolderFullPath = objFolder.Items.Item.Path
Else
strFolderFullPath = objFolder.Items.Item.Path
End If
Else
‘// User cancelled
GoTo XitProperly
End If
GotIt:
fnBrowseForFolderShell = strFolderFullPath
XitProperly:
Set objFolder = Nothing
Set objShell = Nothing
End Function
Function fnGetEventInput() As Byte
‘// Get Event input
Dim Tmp
Dim Val As Byte
Tmp = UCase(Application.InputBox("Event – Enter;" & vbCrLf & vbCrLf & _
"Enter any combination of letters that represent" & vbCrLf & _
"any one of the events below" & vbCrLf & _
"D (Delete), C (Create), M (Modify)", _
"Event to Monitor for: ", _
"DCM", _
Type:=2))
‘// Use default ALL
If Tmp = "False" Then fnGetEventInput = 7: Exit Function
If InStr(1, Tmp, "D") > 0 Then Val = 1
If InStr(1, Tmp, "C") > 0 Then Val = Val + 2
If InStr(1, Tmp, "M") > 0 Then Val = Val + 4
‘// Use default ALL
‘If Val = 0 Then Val = 7
‘MsgBox Val
‘MsgBox "1st bit set = " & (Val And 1) & CBool((Val And 1))
‘MsgBox "2nd bit set = " & (Val And 2) & CBool((Val And 2))
‘MsgBox "3rd bit set = " & (Val And 4) & CBool((Val And 4))
fnGetEventInput = Val
End Function
Sub TerminateOurRunningScript()
‘—————————————————————————————
‘ Procedure : TerminateOurRunningScript
‘ DateTime : 3/07/2006 10:58
‘ Author : Ivan F Moala
‘ Purpose : See IF OUR Script is running JUST IN CASE there is another script running!
‘ : BEFORE Terminating it.
‘—————————————————————————————
Dim objWMIService As Object
Dim colItems As Object
Dim objItem As Object
Dim Msg As String
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\" & "." & "
ootCIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", "WQL", 48)
For Each objItem In colItems
‘// The name of the program = "wsscript.exe" or "cscript.exe"
If objItem.Caption = m_cWsh Or objItem.Caption = m_cCsh Then
‘// msg Contains the path of the exercutable script
Msg = objItem.CommandLine
MsgBox Msg & vbCrLf & m_strScriptRunPath
‘// See if this is OUR SCRIPT
If InStr(1, Msg, m_strScriptRunPath) > 0 Then
MsgBox "True"
objItem.terminate
End If
End If
Next
Set objWMIService = Nothing
Set colItems = Nothing
End Sub
Hi Ivan :)
This is great and I’ve tested it with
– Windows XP SP-2 Swedish version
– Excel 2002 SP-3 Multi Language (Swedish)
– All kind of defensive protection tools activated
Creating and Deleting files are working properly while it appears it does not catch when files have been modified.
I suspect that any active protection tools on the computer may prevent the script to get access to files. I will make additional tests on a virtualized os with no protection tools installed.
I use UltraEdit and it always create new backups files (BAK) of created/modified files and it works as expected in that it alerts for new files (including new BAK-files) but not when BAK-files are deleted.
All the very best from,
Dennis
Ivan,
It’s weird that the modification alerts don’t get fired. I tested it with a virtualized version of Windows XP (English) and Excel 2007 and the same outcome is obtained.
I’m not the person who can spot the error in Your code so hopefully someone else can give You a better input than me.
All the very best from,
Dennis
Dennis
Yes, I noted this when I tested, couldn’t fig out why … thought it may be a system thing.
Will look further.
Thanks as always for your input, really apprecite this.
Hi Ivan,
Amazing…….. I thougt you had disappeared….Its ages since there have been updates on your website…hope you will get back soon…
“I’m not the person who can spot the error in Your code….”
Forget errors…It will take me years to figure out how your code works :-)
Best Regards
Sam
Hi Sam, yes it has been ages, unfortunately I have had things @ home to deal with.
I hope to get back into it now. I thought I would post here first for input
rather then my site and get feed back on OS it works on. I beleive that
it will only run on XP onwards.
Ivan,
Just for fun I made a test with Windows 2000 (English SP-4) and Excel 2000 (English SP-3)and it works great when it comes to creating and deleting files in a folder.
BTW, have You considered to use Windows API instead?
All the very best from,
Dennis
Thanks Dennis,
API ? I may ??
The solution is either something really simple or I have missed something.
I looked @ MS Site but nothing really came up there.
Any way …. thanks for your trials.
Ivan
Ivan,
I had the impression that FindFirstChangeNotification and FindNextChangeNotification APIs could monitor files but it seems only possible to use them for directories and directory tree.
BTW, I’ve added to my ‘To do’-list to make a write up about FileSystemWatcher on the .NET platform.
All the very best from,
Dennis
No need to make any write up about FileSystemWatcher:
http://www.codeproject.com/dotnet/folderwatcher.asp
Kind regards,
Dennis
Thank God I am not the only one having the problem with the __InstaneModificationEvent not firing. It has been driving me mad! Has anyone figured out why it’s not working??
great – going from vba to vbs. works for me with xp sp2, office 07
i know this is now an old page now, but if you are still looking can you offer any advice on adapting the wmi call to monitor two folders? or even more????
Thanks
Ivan,
This is a beautiful piece of coding. I’ve been playing with WMI recently, and I had figured on some heavy duty reading to get clued up on running WMI effectively in script form rather than VBA. So this is a treasure trove
Regards
Dave (brettdj)
Dear Ivan
I am looking for the code of VBA to monitor the modification of folder. I wonder if you could provide several lines of the program.
I will use my own VBA programmable interface. So what I need is the code of “monitoring” the any modification of the folder. I will use also my own “notification”, which has been written down in VBA.
I appreciate it very much if you could help!
Sincerely
Xiaobao Fan
Canada
Hi, truly appriciate the code.
wanted to use this code to read a text file the moment they are created in a directory and write the contents of the text file in the same excel sheet.
Thanks in adv.
is it possible to include subfolder
please email the code.
thanks
Hi Ivan,
could you please explain little bit more how to run this module
Thanks in Advance
Venkateswarlu P