PDA

View Full Version : Monitor Folder code goes into a loop



El_Diabolo
12-24-2013, 04:49 PM
Hi All,


I am using Windows 8, Office 2010 32-bit on a stand-alone laptop.

This is a resurrection of a post ("Import Word file name into Excel" of 12/12) which I thought had been solved, but not quite it appears.

Here is what I am trying to do:

1. I am using an Excel sheet as a menu from which the user chooses an option.
2. They can either open an existing, or "create" a new, Excel workbook, or Word document. I say "create", but in fact this option opens an existing empty workbook/document and this is then "Saved As" a new file.
3. When a new file is created it is then added to the menu so that it can be opened in future as an existing file.
4. The Excel/Workbook files are accessed by using ActiveWorkbook.FollowHyperlink.

The Word portion of the above works fine, but the Excel portion goes into a loop. I have tried using "Workbooks.Open" instead of the Hyperlink method, but no difference. I have searched for alternative solutions, but to no avail. The Monitor Folder code is posted below. From what I have read it seems to be well known and well used, so I'm guessing others must be having success with it. Ultimately what I need is to capture the new file name so that I can then process it further. As I say, it works fine for Word, but goes into a loop in Excel. Any help is much appreciated.





' Monitor folder for change
Sub MonitorDirForNewFile()
'// Amended from http://www.microsoft.com/technet/scr...5/hey0404.mspx
Dim strComputer As String
Dim strDirToMonitor As String
Dim strTime As String
Dim objWMIService As Object
Dim colMonitoredEvents As Object
Dim objEventObject As Object




strComputer = "."
'// Note 4 forward slashes! (I thought the slashes below were back-slashes?)
strDirToMonitor = "C:\\\\Meeting 2013"


'// Monitor Above folder every three seconds...
strTime = "3"


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) & "'")

DoEvents
Do While True
Del = "N"
Set objEventObject = colMonitoredEvents.NextEvent()


Select Case objEventObject.Path_.Class
'// This is the one you want
Case "__InstanceCreationEvent"
MsgBox "A new file was just created: " & _
objEventObject.TargetInstance.PartComponent
'// Place in avail cell
Range("A65536").End(xlUp).Offset(1, 0) = objEventObject.TargetInstance.PartComponent
Exit Do
Case "__InstanceDeletionEvent"
MsgBox "A file was just deleted: " & _
objEventObject.TargetInstance.PartComponent
Exit Do
End Select
Loop


X:


Set objWMIService = Nothing
Set colMonitoredEvents = Nothing
Set objEventObject = Nothing


End Sub




Best regards.

SamT
12-24-2013, 06:57 PM
Do While True True is always True. The loop will run until True = False.

Edit to add: It was the Wild Turkey, I tell you. Yeah. That's it Wild Turkey. That's me story and I'm sticking to it..

:crying:

westconn1
12-25-2013, 02:34 AM
your loop only monitors for newly created files and deleted files,
BUT

I say "create", but in fact this option opens an existing empty workbookis the folder you are monitoring where the workbook is savedAs?

there are also, APIs to monitor folders, with call back, so no need to loop in excel

edit,:- i tested your code it appears to work fine, with msgbox when file is created in folder (from outside excel), and exit from loop
personally i would replace the do loop with a call to an other procedure using recursive application.ontime, as that would leave excel more responsive

El_Diabolo
12-25-2013, 06:25 AM
SamT: thanks for your reply. Firstly, may I apologise if I did not make clear what I am trying to do. I am trying to capture the file name of any new file created during the process I described in my post. As for "True is always True", the code works fine for processing Word documents, but not for Excel. I would have thought that it would be true as much for one as the other. Clearly there is something I just don't get. The loop exits OK when a new word document is "Saved As", but I simply cannot get to that stage with Excel because it is looping. How it can ever get to be False I just don't see.

Westconn1: again, thanks for your reply. Yes, the monitored folder is where the workbook is "Saved As". I will look into your suggestions regarding APIs and recursive calls. All new to me, but thanks for the pointers.

Best regards to all.

SamT
12-25-2013, 09:10 AM
El_D.

No. That was my bad. I was in a hurry and did not thoroughly read your code. I saw, I jumped, and I ran with it. Wrongly.

Assuming that the Workbook that was used to "create" the new book is still open when it is Saved As.you might look into using the Application.WorkbookBeforeSave Event.

Algorithm:
Compare wb.Name to existing list of "createable" books
If in list Then
Cancel = True
InputBox to get name to be Saved As
Programatically save the book
Else Show SaveAs Dialog

Kenneth Hobs
12-25-2013, 09:43 AM
I would not use an infinite loop like that. Even using an API method to watch a folder might be too much for my taste. I prefer a vb.net method myself. If you need to log activity, output from the EXE folder watching program can be sent to a log file.

IF vb.net method interests you, I just saved my example to: https://app.box.com/s/1ywdkoccofam1u4gkpbu

I documented how I made WatchFolder.exe in the first two lines of code as I do for most of my VBA code.
'Initial code from link below based on http://www.codeproject.com/KB/dotnet/folderwatcher.aspx
'Some code from http://www.developerfusion.com/article/3636/watching-folder-activity-in-vbnet/2/

I have seen API examples. If that interests you, then post back if you want to pursue that and get help.

El_Diabolo
12-25-2013, 09:59 AM
SamT: Thanks again for your reply. Not to worry about jumping in. I appreciate you taking the time to reply. Unfortunately I don't completely understand what you suggest, but I'm probably being very stupid. As follows:

1. In my experience the workbook on which the "Save As" is executed is automatically closed and the workbook then on screen is the newly named workbook. So the WorkbookBeforeSave event would be operating on the "wrong" workbook.

2. I'm not sure how to find the "existing list of createable books" that you mention and, again, I think I would be comparing the "wrong" workbook name.

3. The InputBox method: I had thought of doing it this way, since, as best as I can tell, it means I don't have to bother with any folder checking or recursive calls, since I will obviously have the file name from the InputBox.
However, the user may find it odd that the normal protocol is not being followed. I would not completely rule out using this method, but I was trying to make it as seemless as possible for the user.

Having said all of that I am probably misunderstanding the details you give below "Algorithm:" in your reply. I do apologise for my stupidity.

Best regards.

El_Diabolo
12-25-2013, 11:24 AM
Kenneth: Thank you for your expansive reply. Sorry for not getting back sooner, but I have only just seen it. (Normally I get an email when a reply is posted, but today that does not seem to be happening). I will study what you have given me and get back when I understand what's what. Thanks again.

Best regards.

Kenneth Hobs
12-25-2013, 11:34 AM
I noticed that. The forum auto-email must be on holiday? I did notice that the file was downloaded so I checked here.

SamT
12-25-2013, 12:56 PM
Sorry, from the level of coding in your example, I though you were an advanced programmer.

1: Workbook_BeforeSave is run as soon as the User selects File>>Save or File>>SaveAs or presses Ctrl+S. In other words, it is run against the currently Active workbook.

2: I was referencing your your original post, specifically "added to the Menu [I assumed some list somewhere]"
1. I am using an Excel sheet as a menu from which the user chooses an option.
2. They can either open an existing, or "create" a new, Excel workbook, or Word document. I say "create", but in fact this option opens an existing empty workbook/document and this is then "Saved As" a new file.
3. When a new file is created it is then added to the menu so that it can be opened in future as an existing file.
4. The Excel/Workbook files are accessed by using ActiveWorkbook.FollowHyperlink.

3: I think that your Users will quickly become used to having the Book saved as soon as they click the OK button on the InputBox. If they complain too much:

In ThisWorkbook Code
Option Explicit

Dim myDialog As New modCustomSaveAs

Sub Workbook_Open()
Set myDialog.App = Application
End Sub
In Class Module named "modCustomSaveAs"
Option Explicit

'this Object monitors all Save As Events across all open Workbooks.

Public WithEvents App As Application

Dim mNewName As String


Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NewName As Variant

'If you don't want to run this against an existing Wb, put that code here

NewName = Application.GetSaveAsFilename
If NewName = False Then
mNewName = "False"
Cancel = True
Exit Sub
Else
'Validation and error checking code here
'You can put the code from Sub MonitorDirForNewFile here and not use it elsewhere. Delete all references to mNewName.

mNewName = NewName
End If
End Sub

Property Get NewName()
NewName = mNewName

'Reset after Property is gotten
mNewName = "False"
End Property

Replace your Sub MonitorDirForNewFile
' Monitor folder for change
Sub MonitorDirForNewFile()
'// Amended from http://www.vbaexpress.com/forum/showthread.php?48525-Monitor-Folder-code-goes-into-a-loop
Dim strTime As String
Dim NName As String

Do While True
DoEvents
NName = myDialog.NewName
If Not LCase(NName) = "false" Then
MsgBox "A new file was just created: " & NName
'// Place in avail cell
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = NName
'IF this only checks the first instance Then
'Set myDialog = Nothing
'Exit Do
End If
Loop
End Sub

As written, this will probably crash some part of the rest of your project. I leave it to you to properly insert all that code.

El_Diabolo
12-25-2013, 01:10 PM
Kenneth: thanks again. I had a quick look at your file, but Christmas dinner is now upon me. I will try it out as soon as I get a chance.

SamT: Thank you very much - you have gone to a lot of trouble. Unfortunately I am now involved in Christmas dinner, so it will be tomorrow before I get a chance to work with your code.

I will keep everyone posted.

Best regards to all and Happy Holidays.

westconn1
12-25-2013, 03:59 PM
on further testing with your original code you do not need the do loop at all, unless you want to continuously monitor for new files, but then exit do will stop that anyway
but even without the do loop, excel became unresponsive while monitoring the folder, to the extent that i could not save a workbook while the monitoring was taking place, all files created in that folder from windows explorer (or other apps) worked correctly

as you are using saveAs the filepath\name should be readily available within excel, using the before save event as suggested, or if the save as is by code the path\ filename are already in the coding

El_Diabolo
12-25-2013, 05:56 PM
westconn1: thanks for looking into my question further. I have still to investigate the solutions suggested above by Kenneth Hobs and SamT. My simple little brain needs time to digest what they are proposing. However, from what both you and SamT are saying about using the BeforeSave event it is clear that I have a fundamental misunderstanding of what you mean. My take on it is as follows:

1. The user selects the menu option to "create" a new workbook.

2. They are then presented with a workbook called "New Empty Workbook".

3. They enter whatever data they want and then perform a "SaveAs", naming it e.g., "Attendee List". At this point "New Empty Workbook" has disappeared.

Certainly I can insert a BeforeSave event into the code of "NewEmptyWorkbook", thereby capturing that workbook's name, but I can't insert a BeforeSave event into the"Attendee List" workbook because it doesn't exist until the user gives it a name. Sorry if I am being extra thick, but I just don't see how I can trap the name of the "SavedAs" workbook using this method. You are right that I don't want to perform continuous monitoring. I only want to get the name of the newly saved workbook. The simplest way possible the better. I don't doubt that the code from SamT will work, but if you have a simpler solution I would love to have it.

Thanks for your time. Best regards.

westconn1
12-26-2013, 05:43 AM
while i agreed with the idea of using the before save event, on testing, i do not see you can return the name the workbook is to be savedAs, only the original name possibly Sam or someone will have better idea on this, also the code in the beforesave event will be saved with the workbook and will run anytime the workbook is saved or savedAs unless some condition is put in so it will only run with the original name

on further testing, monitoring the folder prevents the file from being saved until the monitoring is finished, even when monitoring the folder is called from the before save event

the only simple successful solution i found, was to modify your monitor folder code slightly, save it as a VBS file, then shellexecute the vbs file in the before save event, again, needs to be conditional on the original workbook name

i did not go as far as automating excel from the script file, but that is not hard to do anyway, the msgbox showed whenever the workbook was savedAs


' in a module at the top in the general section
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) _
As Long

' in thisworkbook
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
if thisworkbook.name = "New Empty Workbook.xls" then ShellExecute 0, "Open", "pathto\monitorfolder.vbs", "", "", 0 ' change path to suit and workbook name to suit
End Sub


' in a textfile named monitorfolder.vbs, from your original code, make sure the textfile is not saved with .txt extension
strComputer = "."
'// Note 4 forward slashes! (I thought the slashes below were back-slashes?)
strDirToMonitor = "C:\\\\temp"


'// Monitor Above folder every three seconds...
strTime = "3"


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) & "'")

Set objEventObject = colMonitoredEvents.NextEvent()

Select Case objEventObject.Path_.Class
'// This is the one you want
Case "__InstanceCreationEvent"
MsgBox "A new file was just created: " & _
objEventObject.TargetInstance.PartComponent
'// Place in avail cell
' excel would need to be automated here to obtain a workbook or sheet object for the below range
' Range("A65536").End(xlUp).Offset(1, 0) = objEventObject.TargetInstance.PartComponent
Case "__InstanceDeletionEvent"
MsgBox "A file was just deleted: " & _
objEventObject.TargetInstance.PartComponent
End Select


Set objWMIService = Nothing
Set colMonitoredEvents = Nothing
Set objEventObject = Nothing

El_Diabolo
12-26-2013, 07:22 AM
westconn1: thank you very much for all your work. Your solution looks good (although coming from me that's probably the kiss of death!). As soon as I get a chance I will give it a try. Thank you for spending your holiday time on this for me. It is MUCH appreciated. I just find it amazing the quantity and quality of help all you guys provide to duffers like me. Really - just amazing. Can't thank you all enough.

Very best regards. More anon....

SamT
12-26-2013, 07:49 AM
There are two Before Save Events. Workbook_BeforeSave is local to the book being saved and (Application Class Object)_WorkbookBeforeSave is global to Excel.

I am sorry that I wasn't clear, the last code I posted all goes in the workbook with the menu, not in any workbook "created." Unless it is modified to die as indicated in it's comments, it quietly sits in memory and waits for a BeforeSave Event without using any CPU time.

El_Diabolo
12-26-2013, 08:57 AM
SamT: thank you once again for your time and effort, and for interrupting your holiday time to help me. Sadly, I can't manage to free myself sufficiently from Christmas events at the moment to concentrate on Excel events. As soon as I can I will try the solutions I have been given and report back. Meanwhile, thanks again. All this help is fantastic.

Best regards.

El_Diabolo
12-27-2013, 11:53 AM
SamT: Sorry to trouble you again, but I can't get your solution to run. No doubt I have messed up somewhere. I am including the code I have assembled from your post. It is in a new workbook, just to keep things simple. Ha!
I am not attaching the workbook as such, since I understand attachments are only allowed on Main posts. However, there is absolutely nothing in the workbook code other than the code I post below.
There are two separate problems, as Follows:

1. When I execute A SaveAs via the Input Box without the "MonitorDirForNewFile" code inserted then Excel goes into a loop.

2. When I insert the "MonitorDirforNewFile" code I get variable not defined on "myDialog".

I have tried to suss it, but to no avail.



This Workbook:

Option Explicit

Dim myDialog As New modCustomSaveAs

Sub Workbook_Open()
Set myDialog.App = Application
End Sub

Class Module "modCustomSaveAs":

Option Explicit


Public WithEvents App As Application

Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)


Dim NewName As Variant
Dim Message, Title
Message = "Please enter the new file name" ' Set prompt.
Title = "Save File with the Name Entered" ' Set title.
' Display message, title, and default value.
NewName = InputBox(Message, Title)


If IsEmpty(NewName) Then
Cancel = True
Exit Sub
Else
Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=NewName & ".xlsm"


Dim NName As String

Do While True
DoEvents
NName = myDialog.NewName
If Not LCase(NName) = "false" Then
MsgBox "A new file was just created: " & NName
'// Place in avail cell
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = NName
'IF this only checks the first instance Then
Set myDialog = Nothing
Exit Do
End If
Loop


End If


Application.EnableEvents = True
End Sub





Many thanks for any help you can provide.

Best regards.

westconn1
12-27-2013, 03:09 PM
you are supposed to add a class module to the workbook code modules
most of the code then goes in the class module

Class Module named "modCustomSaveAs":

only the first 5 lines go in the thisworkbook code module

El_Diabolo
12-27-2013, 04:01 PM
westconn1: Thanks again for your reply. Sorry for not posting the workbook, but I am trying to follow the rules (I think). I have actually done as you suggest. If you take a look at my previous post I have split the code into two sections - "This Workbook" and " "Class Module modCustomSaveAs". It doesn't seem to like "myDialog". i.e., "NName = myDialog.NewName". It tells me that "myDialog" is "variable not defined". Not sure why.

Best regards.

GTO
12-27-2013, 09:54 PM
Greetings El Diabolo,

I would suggest attaching a workbook with what you currently have done.

Hope that helps,

Mark

westconn1
12-27-2013, 10:28 PM
your copy of the code is quite different from the original post by samT, the code where the error occurs should be in Thisworkbook code module, where it is local to the mydialog variable
Replace your Sub MonitorDirForNewFile and must be run after the newname property has been set (get)

it seems strange to me that if the user savesAs using the saveAs dialog, needing to enter the new name again in a Application.GetSaveAsFilename or an inputbox, or why a do any loop at all to monitor the folder if the new name is already known by this method

El_Diabolo
12-28-2013, 05:56 AM
Me again. I can only assume that the scope of "myDialog" is the problem, but since SamT's code is beyond my scope I don't know how to fix it. Any help please. Thank you.

SamT
12-28-2013, 08:28 AM
I looked at your latest code and came up with this version. I have tested it and it works on my Excel 2003.

I think there are enough comments that you can modify it as needed. The Constants in the Class module MUST be set to your own values. Be sure to remove the references to .xls files in the DefaultFilter constant.

The myDialog object will exist (run) until the workbook it is in is closed. for the attachment, that means the it will run until El_diable.xls is closed.

Coder Tips:


Of course as the coder, you can use the Thisworkbook Sub KillmyDialog() to end it.
The ResetEvents sub came about because during development the Class would error out after setting Application.EnableEvents to false.
There is no easy way to tell if the Class is running, so Sub TestmyDialogExists tests the Class Object.
RestartmyDialog is so one doesn't have to run the Sub Workbook_Open.


In fact it would be better code to rename Restartmydialog to either StartmyDialog or InstantiatemyDialog and call it from sub Workbook_Open in case the Workbook_Open has other code in it.

Here is the code for everybody, so they don't have to DL the workbook.

ThisWorkbook Code
Option Explicit

Dim myDialog As Object

Sub Workbook_Open()
Set myDialog = New modCustomSaveAs
Set myDialog.App = Application
End Sub


'''''Test and development stubs
Sub TestmydialogExists()
If Not myDialog Is Nothing Then
MsgBox "myDialog is running"
Else: MsgBox "mydialog is not running"
End If
End Sub

Sub ResetEvents()
Application.EnableEvents = True
End Sub

Sub KillmyDialog()
Application.EnableEvents = True
If Not myDialog Is Nothing Then Set myDialog = Nothing
End Sub

Sub RestartmyDialog()
Set myDialog = New modCustomSaveAs
Set myDialog.App = Application
End Sub

Class "modCustomSaveAs" code
Option Explicit

Public WithEvents App As Application



Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)


Const DefaultFolder As String = "F:\Desktop\" 'Change as needed. ex: "C:/Meeting 2013/cimv2"
Const DefaultFilter As String = "Excel Files (*.xls; *.xlsm; *.xlsx),*.xls;*.xlsm;*.xlsx" 'xls added for SamT use.
Const SavedBooksListSheet As String = "Sheet1" 'Change as needed

Dim NewName As Variant

Do
NewName = App.GetSaveAsFilename(InitialFileName:=DefaultFolder, FileFilter:=DefaultFilter)
If NewName = "False" Then
Exit Sub
ElseIf NewName = ThisWorkbook.Name Then
Exit Sub
End If
Application.EnableEvents = False

'Do not accept original Name
Loop While NewName = DefaultFolder & ActiveWorkbook.Name
Cancel = True

ActiveWorkbook.SaveAs Filename:=NewName
ThisWorkbook.Sheets(SavedBooksListSheet).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = NewName

Application.EnableEvents = True

'Class will die when ThisWorkbook is closed
End Sub


Private Sub Class_Initialize()

End Sub

Sub Class_Terminate()

End Sub

Edited to add: I'm sorry, I forgot to add where to get help in the far future to the code. Can you add this comment to the top of the Class code page?

'Thanks to http://www.vbaexpress.com/forum/showthread.php?48525-Monitor-Folder-code-goes-into-a-loop

El_Diabolo
01-18-2014, 12:21 PM
SamT: Thank you so much for your expansive and extremely detailed reply. I have only just received an email about it, but I see your post is dated 28/12. I am sure I had looked at the thread more recently than that, so I'm not sure why I didn't see it. Please accept my apologies for not responding sooner. I won't be able to work with it until Monday, I'm afraid, but I will post back as soon as I have done so. Again, many thanks for your considerable time and effort.

Best regards,

El_D