excelvba

Save Excel file to newly created folder one level up in directory


I would like to save my file in the folder created one level up in directory.

Set apfwb = Workbooks.Open(PathName & "\Resources\template V0.2.xlsm")
Dim apffr As Worksheet
Dim myFileName As String
Dim Path As String, FinalPath As String
Dim fso As Object
Dim fldrname As String, fldrpath As String

Path = Application.ActiveWorkbook.Path
FinalPath = Left(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\"))
myFileName = "Pack v0.2.xlsm"

Set fso = CreateObject("scripting.filesystemobject")
fldrname = "APF-MDU"
fldrpath = FinalPath & fldrname
FinalFile = fldrpath & myFileName
If Not fso.FolderExists(fldrpath) Then
    fso.createfolder (fldrpath)
End If

If FileLen(fldrpath & myFileName) > 0 Then
    MsgBox ("File arleady exists!")
    Exit Sub
Else
    Application.ActiveWorkbook.SaveAs fileName:=fldrpath & myFileName, 
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If

The file is saved next to the newly created folder.

How could I save it inside the newly created folder?


Solution

  • Create Workbook From Template

    A Quick Fix

    'Dim apfwb As Workbook ' declared previously???
    'Dim PathName As String ' declared and populated previously???
    
    Dim apffr As Worksheet ' ???
    Dim fso As Object
    Dim fldrname As String, fldrpath As String
    Dim myFileName As String, FinalPath As String
    
    fldrname = "APF-MDU"
    myFileName = "Pack v0.2.xlsm"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    fldrpath = PathName & "\" & fldrname & "\"
    If Not fso.FolderExists(fldrpath) Then fso.CreateFolder fldrpath
    FinalPath = fldrpath & myFileName
    
    If fso.FileExists(FinalPath) Then
        MsgBox ("File arleady exists!")
        Exit Sub
    Else
        Set apfwb = Workbooks.Open(PathName & "\Resources\template V0.2.xlsm")
        apfwb.SaveAs Filename:=FinalPath, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End If
    

    An Improvement (Standalone)

    Sub CreateFromTemplate()
       
        Const ROOT_PATH As String = "C:\Test"
        Const TEMPLATE_SUB_FILE_PATH As String = "Resources\Template V0.2.xlsm"
        Const NEW_FOLDER_NAME As String = "APF-MDU"
        Const NEW_FILE_NAME As String = "Pack v0.2.xlsm"
    
        Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
        
        Dim nFolderPath As String:
        nFolderPath = fso.BuildPath(ROOT_PATH, NEW_FOLDER_NAME)
        
        If Not fso.FolderExists(nFolderPath) Then fso.CreateFolder nFolderPath
        
        Dim nFilePath As String:
        nFilePath = fso.BuildPath(nFolderPath, NEW_FILE_NAME)
            
        If fso.FileExists(nFilePath) Then
            MsgBox "The file """ & nFilePath & """ already exists!", vbExclamation
            Exit Sub
        End If
    
        Dim tFilePath As String:
        tFilePath = fso.BuildPath(ROOT_PATH, TEMPLATE_SUB_FILE_PATH)
        
        Dim wb As Workbook: Set wb = Workbooks.Open(tFilePath)
        
        wb.SaveAs Filename:=nFilePath, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
        'wb.Close SaveChanges:=False ' just got saved
        
    End Sub