VBA in word

[showboat098]

Please excuse me for I'm a novice when it comes to both VBA and this board. I apologize for the length of this. A project I'm working on at work involves multiple steps. The First step asks the user for the current quarter and year. The second step a userform pops up that allows the user to select a team to outsource to. The userform consists of 21 checkboxes. The command button is set to run through two previously stated folders and to read the first three letters of each file within that folder, and match those to the first three of an associated folder within that master folder. I've accomplished this using the following code:

Public thisQuarter As String
Public thisYear As String
Sub Copy_folder()

askForQuarter:
'prompts for quarter, checks if user hit cancel then if 2 chars were entered
thisQuarter = InputBox("Please enter the current quarter", "Quarter", "(i.e. Q2)")

If thisQuarter = "False" Then
Exit Sub
End If

If Len(thisQuarter) < 2 Or Len(thisQuarter) > 2 Then
MsgBox "The format you used to enter the quarter is incorrect. Please enter the quarter in the format Q# (i.e. Q2)", , "Invalid Input"
GoTo askForQuarter
End If

askForYear:
'prompts for year, checks if user hit cancel then if 4 chars were entered
thisYear = InputBox("Please enter the current year", "Year", "(i.e. 2011)")


If thisYear = "False" Then
Exit Sub
End If

If Len(thisYear) < 4 Or Len(thisYear) > 4 Then
MsgBox "The format you used to enter the year is incorrect. Please enter the quarter in the format YYYY (i.e. YYYY)", , "Invalid Input"
GoTo askForYear
End If
Dim FromPath As String
Dim Tester As String
Dim Test2 As String
Dim ToPath As String
Dim ToPath2 As String
Dim FSO As Object
Tester = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\eVestment\Long Duration Team\"
Test2 = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\Mercer\Long Duration\"
ToPath = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\eVestment"
ToPath2 = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\" & thisYear & thisQuarter & "\Semi-Annual PDM Review\Mercer"
FromPath = "Z:\home\Marketing\common\BDS Associates\Consultant Database Group\D - Quarterly Files & Notes\Support"
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(Tester) = False Then 'if topath doesn't exist then copy frompath to topath
FSO.CopyFolder source:=FromPath, Destination:=ToPath

End If

If FSO.FolderExists(Test2) = False Then

FSO.CopyFolder source:=FromPath, Destination:=ToPath2
End If
Call ShowDialog
End Sub


Sub ShowDialog()
Productform.Show

End Sub


I've been successful in getting the files to copy into the correct folders, but the code is very long and defines each checkbox. I'd like to shorten the code using a for-loop and a variable. One example of the functioning code in the userform is as follows:


Private Sub CheckBox1_Click()
End Sub

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 Chkbx As String

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")
If Me.CheckBox21.Value = True Then 'Sets all check boxes as true if "select all" is true. Select All is checkbox 21
CheckBox1.Value = True 'if a checkbox is added make sure to change the "select all" checkbox number and add the new checkbox to this list
CheckBox2.Value = True
CheckBox3.Value = True
CheckBox4.Value = True
CheckBox5.Value = True
CheckBox6.Value = True
CheckBox7.Value = True
CheckBox8.Value = True
CheckBox9.Value = True
CheckBox10.Value = True
CheckBox11.Value = True
CheckBox12.Value = True
CheckBox13.Value = True
CheckBox14.Value = True
CheckBox15.Value = True
CheckBox16.Value = True
CheckBox17.Value = True
CheckBox18.Value = True
CheckBox19.Value = True
CheckBox20.Value = True
End If


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

If Me.Controls("checkbox2").Value = True Then
i = "Absolute Return"
End If

For Each fileObj In FileComp
Str1 = Left(fileObj.Name, 3)
If Str1 = Left(i, 3) Then
FromPath = fileObj
ToPath = Home1 & i & "\" & fileObj.Name
FSO.MoveFile source:=FromPath, Destination:=ToPath
End If
Next
For Each fileObj In fileComp2
Str1 = Left(fileObj.Name, 3)
If Str1 = Left(i, 3) Then
FromPath = fileObj
ToPath = Home2 & i & "\" & fileObj.Name
FSO.MoveFile source:=FromPath, Destination:=ToPath
End If
Next


The previous code is repeated 20 times. I'm attempting to replace that code with something like the following in order to assist in the next step where those folders are zipped and attached to automatically drafted emails:

For i = 1 To 20

If Me.Controls("checkbox" & i).Value = True Then
Str1 = Left(fileObj.Name, 3)
' Chkbx = "Checkbox & i".Caption
' If Str1 = Left(i, 3) Then
ElseIf Str1 = Left(Chkbx, 3) Then
FromPath = fileObj
' ToPath = Home1 & i & "\" & fileObj.Name
ToPath = compDir2 & "\" & Me.Controls("checkbox" & i).Caption
FSO.MoveFile source:=FromPath, Destination:=ToPath
End If
Next

I greatly appreciate any help you can give me.