Copying a template workbook, renaming, and editing as part of a loop

CodePest

New Member
Joined
Jan 16, 2018
Messages
13
Hello all,

I've run into a problem with some code I'm writing. I can't seem to get my code to copy and rename a file consistently. It will do it once, but then it doesn't work after the first name. Essentially, I have a table of employee names in a workbook. I've written macro that will rename a template based on the information in the list, here's an example:[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD="align: center"]Name[/TD]
[TD="align: center"]UserID[/TD]
[TD="align: center"]Position[/TD]
[TD="align: center"]Status[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Alice Calous[/TD]
[TD]1101[/TD]
[TD]Lead[/TD]
[TD]Active[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Joe Geronimo[/TD]
[TD]2202[/TD]
[TD]Agent[/TD]
[TD]Active[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Krissi Prissy[/TD]
[TD]3303[/TD]
[TD]Agent[/TD]
[TD]Active[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Larry Glarey[/TD]
[TD]4404[/TD]
[TD]Agent[/TD]
[TD]Active[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD]dMonth[/TD]
[TD]dYear[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD][/TD]
[TD]February[/TD]
[TD]2018[/TD]
[/TR]
</tbody>[/TABLE]

Here is my code:

Code:
Sub DirectoryCheck()


' Prevents screen flashing during hide/unhide
    Application.ScreenUpdating = False
        
' Define Folder attributes
    Dim dMonth As String
        dMonth = ActiveSheet.Range("C7").Value
    Dim dYear As String
        dYear = ActiveSheet.Range("D7").Value
    
' Define Counters
    Dim FolderCount As Integer
        FolderCount = 0


    Dim TrackPath As String
        TrackPath = "C:\SC\Hub" & dYear
    
    
' Check if File directory for dYear exists


    Dim NewYearFolder As Object


    Set NewYearFolder = CreateObject("Scripting.FileSystemObject")
        
        If NewYearFolder.FolderExists(TrackPath) Then
            
            ' MsgBox ("Folder already exists for " & dYear & ".")
            
            ' If folder exists then create Agent Folders
             Call MakeSheets.CreateFolder(dMonth, dYear, TrackPath, FolderCount)
                
        Else
            
            ' If folder does not exist, create year folder and then create agent folders
            NewYearFolder.CreateFolder (TrackPath)
            MsgBox ("New folder created for " & dYear & " Loans Hub.")
            Call MakeSheets.CreateFolder(dMonth, dYear, TrackPath, FolderCount)
        
        End If


' Prevents screen flashing during hide/unhide
    Application.ScreenUpdating = True
    
MsgBox (FolderCount & " new folders were added.")
ActiveWorkbook.FollowHyperlink TrackPath
    
End Sub



Sub CreateFolder(dMonth As String, dYear As String, TrackPath As String, FolderCount As Integer)


' Define range of agents
    Dim aStart As Integer
        aStart = 2
    Dim aEnd As Integer
        aEnd = 5


    Dim UserID As String
    Dim AgentName As String
    Dim Position As String
    Dim AgentPath As String
    Dim FilePath As String
    
 ' Template folder location
    Dim TemplatePath As String
        TemplatePath = "I:\SC\Hub\TEMPLATE"
   


For i = aStart To aEnd


    ' Define new folder terms
    AgentName = ActiveSheet.Range("D" & i).Value
    UserID = ActiveSheet.Range("E" & i).Value
    Position = ActiveSheet.Range("F" & i).Value
    AgentPath = TrackPath & "" & AgentName
    FilePath = AgentPath & "" & AgentName & ", " & UserID & " - " & dMonth & ", " & dYear & ".xlsm"

' AgentFolder is new file object to be created
    Dim AgentFolder As Object
        Set AgentFolder = CreateObject("Scripting.FileSystemObject")
    
' Defines sheet that will be created
    Dim NewFile As Object
        Set NewFile = CreateObject("Scripting.FileSystemObject")

    
    ' Stop when list ends
    If AgentName = "" Then
        Exit For
        Else
            ' If folder exists then create Tracking Sheets
            If AgentFolder.FolderExists(AgentPath) Then
                
                ' Check if sheet exists, if not make sheet
                    If NewFile.FileExists(FilePath) Then
                    
                        MsgBox ("A tracking sheet already exists for " & AgentName & " for " & dMonth & ", " & dYear)
                    
                    Else
                            MsgBox (FilePath & " will be created.")
                            Set NewSheet = CreateObject("Scripting.FileSystemObject")
                            
                            NewFile.CopyFile TemplatePath & "\Agent App Tracker.xlsm", FilePath
                            
                            Set NewSheet = Nothing
                    
                    End If
                
            ' if not, create agent folder
            Else
            
                AgentFolder.CreateFolder (AgentPath)
                MsgBox (FilePath & " will be created.")
                Set NewSheet = CreateObject("Scripting.FileSystemObject")
                            
                NewFile.CopyFile TemplatePath & "\Agent App Tracker.xlsm", FilePath
                            
                Set NewSheet = Nothing
                FolderCount = FolderCount + 1
            
            End If
        End If
    
Next i


End Sub


The frustrating thing is the code will create the folders, but it will not copy the file. I get an error message that says path does not exist, but for some reason it works for the first name and not the others. I've removed the filecopy code to verify that it will create folders, but when I add the filecopy code back in, it will work for the first name but not the others.

After I get the file copy code working, I also need to open that book and add the AgentName, UserID, dMonth, and dYear onto sheet1 of the new workbook, then close and save it.

I know my code is messy so if there is anything I can do differently, I'm all ears!

Thank you!

Cheers!
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
I did just note that I had NewSheet written where I should have had NewFile, I made that correction, but still the same problem.
 
Upvote 0
OMG!!!!! I just went through my employee list reference and found spaces on the end of the two names I happened to be having problems with! :banghead:
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top