View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Jim Thomlinson Jim Thomlinson is offline
external usenet poster
 
Posts: 5,939
Default SheetBeforeRightClick stops firing after macro repopulates she

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
If sFile < "." And sFile < ".." Then 'Not sure if
this is needed.
'Debug.Print " " & sFile
oAllFiles.Add vFolder & sFile
End If
sFile = Dir
Loop While sFile < ""
End If
Next
Next
'Debug.Print oFolders.Count
lAllFiles = oAllFiles.Count
lblAllFiles.Caption = lAllFiles
ProgressBar1.Max = lAllFiles
cmdExit.Caption = "Stop"

'Reorder list (if necessary) and save root folders list
lListPosition = lPositionIn_oList(cboMasterFileSpec,
cboMasterFileSpec.Text)
If lListPosition 0 Or lListPosition = -1 Then