Monitor Folder code goes into a loop

[GTO]

Greetings El Diabolo,

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

Hope that helps,

Mark

[westconn1]

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]

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]

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]

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