Home |
Search |
Today's Posts |
#8
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thanks for the tip Jim, I oviously didn't know that. Do you have suggestions
of what I could do? My guess would be Me.Hide. I really appreciate the help. "Jim Thomlinson" wrote: You have an End in your code. As soon as that runs all of your globally declared objects are cleared... You need to change this code (and any other End's in your project...) If cmdExit.Caption = "Exit" Or cmdExit.Caption = "Done" Then End Just a note. End is VERY dangerous code. There are two way sto stop your car. Press on the brake until the car gently comes to a stop or to point the car at a brick wall and then wait for the sudden stop. Both will stop your car, but one is a lot less painful than the other. In code, End is equivalent to "point your car at the brick wall and then wait for the sudden stop"... -- HTH... Jim Thomlinson "MAB" wrote: I never destroy the object. When the SheetBeforeRightClick event stops working is when I repopulate the spread sheet with data. Here's the majority of the rest of the code (if you want the template containg all code, I can email it to you.): 'UserForm ----------------------------------------- Option Explicit Dim mbStop As Boolean Dim msSpin As String Private Sub UserForm_Initialize() Dim sWhereToLook As String Dim sMaster_FileSpecs As String Dim sRoots As String Dim sFromRoot_FileSpecs As String Dim vList As Variant Dim vItem As Variant MonthView1.MaxDate = Fix(Now) + 1 MonthView1.Value = (Now - 7) EnabledStartQ sMaster_FileSpecs = GetSetting(gsAppName, gsSection, gsWhereToLook, "optMaster") If sMaster_FileSpecs = "optMaster" Then optMaster.Value = True Else optFromRoot.Value = True End If sMaster_FileSpecs = GetSetting(gsAppName, gsSection, gsMaster_FileSpecs, "*") vList = Split(sMaster_FileSpecs, "|") For Each vItem In vList cboMasterFileSpec.AddItem vItem Next cboMasterFileSpec.Text = cboMasterFileSpec.List(0) sRoots = GetSetting(gsAppName, gsSection, gsRoots) If sRoots < "" Then vList = Split(sRoots, "|") For Each vItem In vList cboRootFolder.AddItem vItem Next cboRootFolder.Text = cboRootFolder.List(0) End If sFromRoot_FileSpecs = GetSetting(gsAppName, gsSection, gsFromRoot_FileSpecs) If sFromRoot_FileSpecs < "" Then vList = Split(sFromRoot_FileSpecs, "|") For Each vItem In vList cboFromRootFileSpec.AddItem vItem Next cboFromRootFileSpec.Text = cboFromRootFileSpec.List(0) End If End Sub Private Sub cmdRemoveListItems_Click() RemoveListItems.Show vbModal End Sub Private Sub cboFromRootFileSpec_Change() EnabledStartQ End Sub Private Sub cboRootFolder_Change() EnabledStartQ End Sub Private Sub optMaster_Click() EnabledStartQ End Sub Private Sub optFromRoot_Click() EnabledStartQ End Sub Sub EnabledStartQ() Dim sMaster_FileSpec As String Dim sFromRoot_FileSpec As String Dim sRoot As String If optMaster.Value = True Then lblMasterFileSpec.Enabled = True cboMasterFileSpec.Enabled = True sMaster_FileSpec = cboMasterFileSpec.Text cmdStart.Enabled = True If sMaster_FileSpec < "" And Not sMaster_FileSpec Like "* *" And _ Not sMaster_FileSpec Like "*.*" Then 'Repair if necessary If sMaster_FileSpec Like ";*" Then cboMasterFileSpec.Text = Mid(sMaster_FileSpec, 2) sMaster_FileSpec = cboMasterFileSpec.Text End If If sMaster_FileSpec Like "*;" Then cboMasterFileSpec.Text = Mid(sMaster_FileSpec, 1, Len(sMaster_FileSpec) - 1) End If cmdStart.Enabled = True Else cmdStart.Enabled = False End If cmdBrowse.Enabled = False lblRootFolder.Enabled = False cboRootFolder.Enabled = False lblFromRootFileSpec.Enabled = False cboFromRootFileSpec.Enabled = False Else cmdBrowse.Enabled = True lblRootFolder.Enabled = True cboRootFolder.Enabled = True lblFromRootFileSpec.Enabled = True cboFromRootFileSpec.Enabled = True sRoot = cboRootFolder.Text sFromRoot_FileSpec = cboFromRootFileSpec.Text If sRoot < "" And Dir(sRoot, vbDirectory) < "" And _ sFromRoot_FileSpec < "" And Not sFromRoot_FileSpec Like "* *" Then 'Repair if necessary If sFromRoot_FileSpec Like ";*" Then cboFromRootFileSpec.Text = Mid(sFromRoot_FileSpec, 2) sFromRoot_FileSpec = cboFromRootFileSpec.Text End If If sFromRoot_FileSpec Like "*;" Then cboFromRootFileSpec.Text = Mid(sFromRoot_FileSpec, 1, Len(sFromRoot_FileSpec) - 1) End If cmdStart.Enabled = True Else cmdStart.Enabled = False End If lblMasterFileSpec.Enabled = False cboMasterFileSpec.Enabled = False End If End Sub Private Sub cmdBrowse_Click() Dim sRootFolder As String sRootFolder = ReturnFolder("Select root folder to search") If sRootFolder < "" Then cboRootFolder.Text = sRootFolder End Sub Private Sub cmdExit_Click() If cmdExit.Caption = "Exit" Or cmdExit.Caption = "Done" Then End Else 'Stop or Wait Able True EnabledStartQ cmdExit.Caption = "Exit" mbStop = True End If End Sub Private Sub cmdStart_Click() On Error GoTo ErrHandler Dim sFolder As String Dim vFolder As Variant Dim sFile As String Dim vFile As Variant Dim oFolders As New Collection Dim oAllFiles As New Collection Dim oMatchingFiles As New Collection Dim specs() As String Dim sFromRoot_FileSpec As String Dim vFromRootFileSpec As Variant Dim sRoot As String Dim iFolders As Integer Dim lAllFiles As Long Dim lFiles As Long Dim lRow As Long Dim lNewerThanCutoff As Long Dim oWorksheet As Worksheet Dim dCutoffDate As Date Dim oRange As Range Dim oFso As New Scripting.FileSystemObject Dim oFile As Scripting.file Dim sPathAndFile As String Dim sFileName As String Dim dFileDate As Date Dim oHyperlink As Hyperlink Dim sValue As String Dim sErrMsg As String Dim oRecurseFiles As New Collection Dim lListPosition As Long Dim sRootFolders As String Dim sFromRoot_FileSpecs As String Dim sMaster_FileSpecs As String Dim x As Long If optMaster.Value Then SaveSetting gsAppName, gsSection, gsWhereToLook, "optMaster" Else SaveSetting gsAppName, gsSection, gsWhereToLook, "optFromRoot" End If ProgressBar1.Value = 0 lblNewerThanCutoff.Caption = 0 lblFile.Caption = "" lblAllFiles.Caption = "" mbStop = False Able False dCutoffDate = MonthView1.Value msSpin = "\" Set oWorksheet = ThisWorkbook.ActiveSheet 'Clear all rows in case data already exists from a previous query (populate spread sheet) lRow = 2 Do sValue = CStr(oWorksheet.Cells(lRow, 1).Value) oWorksheet.Range("a" & lRow).EntireRow.Clear lRow = lRow + 1 Loop While sValue < "" 'Query (populate spread sheet) ------------------------------------------------------ If optMaster.Value = True Then Dim vExt As Variant Dim vSpec As Variant Dim sCombined As String sFromRoot_FileSpec = cboMasterFileSpec.Text For Each vExt In Split(".dwg;.prt;.pdf;.tif;.doc", ";") For Each vSpec In Split(sFromRoot_FileSpec, ";") sCombined = sCombined & ";" & vSpec & vExt Next Next If Left(sCombined, 1) = ";" Then sCombined = Mid(sCombined, 2) specs = Split(sCombined, ";") 'Collect top level folders sRoot = "J:\Master\" sFolder = Dir(sRoot, vbDirectory) ' "." if Do While sFolder < "" SpinAndDoEvents If mbStop Then Exit Sub If sFolder Like "##" Or sFolder Like "[5-9]##" Or sFolder Like "MERLIN" Then oFolders.Add sRoot & sFolder & "\" End If sFolder = Dir Loop sRoot = "J:\!Sorting\CM_MASTER\" sFolder = Dir(sRoot, vbDirectory) ' "." if Do While sFolder < "" SpinAndDoEvents If mbStop Then Exit Sub If sFolder Like "###" Then oFolders.Add sRoot & sFolder & "\" End If sFolder = Dir Loop iFolders = oFolders.Count 'Collect list of all files matching the spec in the top level folders (should be fairly quick). On Error Resume Next 'Needed because oFolders could have some files if files in the root folder have no file extension. For Each vFolder In oFolders 'Debug.Print vFolder For Each vFromRootFileSpec In specs sFile = Dir(vFolder & vFromRootFileSpec, vbNormal) 'Debug.Print " " & sFile If sFile < "" Then Do SpinAndDoEvents If mbStop Then Exit Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Macro stops working when sheet is protected | Excel Discussion (Misc queries) | |||
SheetBeforeRightClick stops firing if macro populates data | Excel Programming | |||
SheetBeforeRightClick stops firing after macro repopulates sheet | Excel Programming | |||
Event sometimes stops firing? | Excel Programming | |||
macro stops copying sheets into a book after the 11th sheet | Excel Programming |