Hi All,
I have the following code that creates a folder and I want to save a file under that folder just created.
I don’t know why but the code creates the file one folder up. (i.e. folder structure is Membership as Top Level, under Membership you have 2019, 2020, 2021).
The new file should be saved under the Membership\2022 folder and be called 2022 Club Membership. However the file is being saved under Membership.
The file that has the macro is a saved file and is located in Z:\Membership\2021 and is being run from there.
The statement hightligted in RED is the Save As that is causing the problem.
It has been wreaking my brains, and I bet it is a simple solution to the experts in this forum.
Any assistance you can offer will be appreciated.
I have the following code that creates a folder and I want to save a file under that folder just created.
I don’t know why but the code creates the file one folder up. (i.e. folder structure is Membership as Top Level, under Membership you have 2019, 2020, 2021).
The new file should be saved under the Membership\2022 folder and be called 2022 Club Membership. However the file is being saved under Membership.
The file that has the macro is a saved file and is located in Z:\Membership\2021 and is being run from there.
The statement hightligted in RED is the Save As that is causing the problem.
VBA Code:
Option Explicit
Sub End_Of_Year()
Application.ScreenUpdating = False
Application.DisplayAlerts = True
Application.StatusBar = True
Dim myYear As Variant
Dim RootFolder As String
RootFolder = ThisWorkbook.Path
RootFolder = Left(RootFolder, InStrRev(RootFolder, "\"))
Dim fPath As String
fPath = ThisWorkbook.Path & "\"
Dim NewPath As String
NewPath = RootFolder & myYear
Dim Confirm As String
Dim AllOk As Boolean
'Copy current Year completed spreadsheet and make it into the Template as you may have added new member to it.
'Create a new spreadsheet for the coming year.
'Ask User to Input a yyyy (format YYYY) that sheets should be created for and validate the response
Do Until AllOk
myYear = InputBox("Please enter the year (Format YYYY) that you want to create the New Club Membership for.", Title:="Create Club Membership Files")
If myYear = "" Then Exit Sub
If Val(myYear) >= Year(Date) Then
Confirm = MsgBox("The Year you want to create files for is " & myYear & ". Is that correct?", vbQuestion + vbYesNo + vbDefaultButton2, Title:="Create Club Membership Files")
If Confirm = vbYes Then AllOk = True
MsgBox ("Starting to create required Club Membership Files."), vbOKOnly, Title:="Create Club Membership Files"
Else
MsgBox "Date entered is " & myYear & " and it is in the past, please enter a vaild date", Title:="Create Club Membership Files"
End If
Loop
'Creating a folder for Year Entered
On Error Resume Next
MkDir RootFolder & myYear
On Error GoTo 0
'Populate Cell Q1 in Sheet named DD Members with the YYYY that will be entered by the User.
Sheets("DD Members").Select
Range("Q1").Value = myYear
Application.DisplayAlerts = False
'Save the existing year file to the year folder that has been entered by the User
[COLOR=rgb(226, 80, 65)]ActiveWorkbook.SaveAs Filename:=NewPath & myYear & " Club Membership.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled[/COLOR]
MsgBox (ActiveWorkbook.Name & " has been created and saved." & vbNewLine & vbNewLine _
& "Press OK to confirm the message."), vbOKOnly, Title:="Create Club Membership Files"
'Having created the file for the next year, Delete all data in columns D (Payment Statement number) and E (Payment Received Date) as you do not want any data in there as it is the start of a new Year.
Range("D3:E202").Select
Selection.ClearContents
Range("D3").Select
ActiveWorkbook.Save
'Having saved the file for next year, then template needs to be saved.
Application.DisplayAlerts = False
'Last statement will ensure you don't get the message to save file exists, do you want to replace.
ActiveWorkbook.SaveAs Filename:=RootFolder & "Club Membership.xltm", FileFormat:=xlOpenXMLTemplateMacroEnabled
Application.DisplayAlerts = True
ActiveWorkbook.Close
End Sub
It has been wreaking my brains, and I bet it is a simple solution to the experts in this forum.
Any assistance you can offer will be appreciated.