File does not save to new created folder.

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
138
Office Version
  1. 2013
Platform
  1. Windows
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.

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.
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,488
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Rich (BB code):
Filename:=NewPath & "\" & myYear & " Club Membership.xlsm"

You were just missing the path separator.
 

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
138
Office Version
  1. 2013
Platform
  1. Windows
RoryA,

Firstly, thank you taking time to help.

I have changed the statement to read

VBA Code:
ActiveWorkbook.SaveAs Filename:=NewPath & "\" & myYear & myYear & " Club Membership.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

and I now get a Runtime error 1004, The file could not be accessed, Try one of the following, make sure the folder exists, make sure the folder that contains the file is not read-only, Make sure that the file name does not contain any special characters,...

You may note that I have & myYear twice on the line. This is becasue the file should be prefixed with the year as well.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,487
Office Version
  1. 2019
Platform
  1. Windows
Hi,
try adding line after your MkDir statement shown in BOLD & see if resolves your issue

Rich (BB code):
On Error Resume Next
    MkDir RootFolder & myYear
On Error GoTo 0

NewPath = RootFolder & myYear

Dave
 
Solution

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,488
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS

ADVERTISEMENT

Ah yes, I just noticed you assign the value to NewPath before you have actually assigned a value to myYear, so as Dave said you should move that line lower in the code.

Note: you do not need myYear twice in the SaveAs line.
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
You are setting the newPAth string before you have inputted the MyYear value.
Try this

VBA Code:
Sub Button2_Click()

End Sub

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
    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
    NewPath = RootFolder & myYear & "\"
    '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

    ActiveWorkbook.SaveAs Filename:=NewPath & myYear & " Club Membership.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    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:=NewPath & "Club Membership.xltm", FileFormat:=xlOpenXMLTemplateMacroEnabled
    Application.DisplayAlerts = True
    'ActiveWorkbook.Close

End Sub
 

Kayslover

Board Regular
Joined
Sep 22, 2020
Messages
138
Office Version
  1. 2013
Platform
  1. Windows
Dmt32, RoryA, Davesexcel,

Thank you very much, works a treat.

I inserted the following
VBA Code:
'Creating a folder for Year Entered

 NewPath = RootFolder & myYear & "\"
On Error Resume Next
        MkDir NewPath
On Error GoTo 0

and I also changed the MkDir to NewPath, as it reads a load better.

Once again, many thanks. :) 👍 👍
 

Watch MrExcel Video

Forum statistics

Threads
1,127,843
Messages
5,627,213
Members
416,230
Latest member
jdaitchman

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
Top