Monitor Directory

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

    Dim MyExcel
    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

Option Explicit
‘—————————————————————————————
‘ 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

Posted in Uncategorized

16 thoughts on “Monitor Directory

  1. 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

  2. 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

  3. 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.

  4. 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

  5. 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.

  6. 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

  7. 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

  8. 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

  9. 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??

  10. 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

  11. 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)

  12. 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

  13. 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.


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.