showboat098
New Member
- Joined
- Dec 3, 2012
- Messages
- 17
I have a userform with a macro attached to scan through all files in a folder and match the caption to the first three letters in the file name. There are 21 check boxes one of which is a select all button. Right now it's set up as the following:
Dim j As Integer
Dim compDir As Object
Dim compDir2 As Object
Dim nameProd As String
Private Sub CommandButton1_Click()
Dim FromPath As String
Dim ToPath As String
Dim FSO As Object
Dim i As Integer
Dim Home1 As String
Dim Home2 As String
'''Dim FileInFromFolder As Object
Dim fileObj As Object
'Dim compDir As Object
Dim FileComp As Object
Dim Str1 As String
'Dim compDir2 As Object
Dim fileComp2 As Object
'Dim nameProd As String
'Dim j As Integer
Home1 = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\eVestment\"
Home2 = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\Mercer\"
'Set FSO = CreateObject("scripting.filesystemobject")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set compDir = FSO.GetFolder("\\nasprodpmwin\marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\eVestment\")
Set compDir2 = FSO.GetFolder("\\nasprodpmwin\marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\Mercer\")
Set FileComp = compDir.Files
Set fileComp2 = compDir2.Files
For j = 1 To 20
If Me.Controls("checkbox" & j).Value = True Then
nameProd = Me.Controls("checkbox" & j).Caption
End If
For Each fileObj In FileComp
Str1 = Left(fileObj.Name, 3)
If Str1 = Left(nameProd, 3) Then
FromPath = fileObj
ToPath = Home1 & nameProd & "\" & fileObj.Name
FSO.MoveFile source:=FromPath, Destination:=ToPath
End If
Next
For Each fileObj In fileComp2
Str1 = Left(fileObj.Name, 3)
If Str1 = Left(nameProd, 3) Then
FromPath = fileObj
ToPath = Home2 & nameProd & "\" & fileObj.Name
FSO.MoveFile source:=FromPath, Destination:=ToPath
End If
Next
Next j
It looks like setting j=1 to 20 makes it compare each caption to each file. I'd rather it only compare the active checkbox captions to the files. Going through that loop 20 times when only one box is checked is a bit excessive and slows the macro a tone. Any suggestions?
Dim j As Integer
Dim compDir As Object
Dim compDir2 As Object
Dim nameProd As String
Private Sub CommandButton1_Click()
Dim FromPath As String
Dim ToPath As String
Dim FSO As Object
Dim i As Integer
Dim Home1 As String
Dim Home2 As String
'''Dim FileInFromFolder As Object
Dim fileObj As Object
'Dim compDir As Object
Dim FileComp As Object
Dim Str1 As String
'Dim compDir2 As Object
Dim fileComp2 As Object
'Dim nameProd As String
'Dim j As Integer
Home1 = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\eVestment\"
Home2 = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\Mercer\"
'Set FSO = CreateObject("scripting.filesystemobject")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set compDir = FSO.GetFolder("\\nasprodpmwin\marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\eVestment\")
Set compDir2 = FSO.GetFolder("\\nasprodpmwin\marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\Mercer\")
Set FileComp = compDir.Files
Set fileComp2 = compDir2.Files
For j = 1 To 20
If Me.Controls("checkbox" & j).Value = True Then
nameProd = Me.Controls("checkbox" & j).Caption
End If
For Each fileObj In FileComp
Str1 = Left(fileObj.Name, 3)
If Str1 = Left(nameProd, 3) Then
FromPath = fileObj
ToPath = Home1 & nameProd & "\" & fileObj.Name
FSO.MoveFile source:=FromPath, Destination:=ToPath
End If
Next
For Each fileObj In fileComp2
Str1 = Left(fileObj.Name, 3)
If Str1 = Left(nameProd, 3) Then
FromPath = fileObj
ToPath = Home2 & nameProd & "\" & fileObj.Name
FSO.MoveFile source:=FromPath, Destination:=ToPath
End If
Next
Next j
It looks like setting j=1 to 20 makes it compare each caption to each file. I'd rather it only compare the active checkbox captions to the files. Going through that loop 20 times when only one box is checked is a bit excessive and slows the macro a tone. Any suggestions?