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:
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!
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!