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