Macro to save a document in current location but in its own folder (Checking if it already exists first)

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,742
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Everyone,

I want a button to save the excel document as the name typed in activesheet cell D5

I want to to save in the current location but in its own folder with the same name thats in cell D5

D5 just holds a name llike "Tony Test" so the folder would be "Tony Test" and the document would be "Tony Test" and "xlsm"

I need the macro to check if the Folder already exists (if so use it instead of creating it)
and if the document already exists in that file, again if so over save it

hope thats clear, could really do with some help here

Thanks

Tony
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
392
Office Version
  1. 2016
Platform
  1. Windows
Hello Tonywatsonhelp,
here is one quick creaed macro.
I hope so it will be helpful.
VBA Code:
Dim vFSO, vOFolder, vOFolder2
Dim vFileName As String, vName As String

Sub SaveToFolder()
    
    Application.DisplayAlerts = False
    vFileName = ActiveWorkbook.FullName
    vName = ActiveSheet.Range("D5")
    Set vFSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set vOFolder = vFSO.GetFolder(ActiveWorkbook.Path & "\")
    If vOFolder.subfolders.Count > 0 Then
        For Each vOFolder2 In vOFolder.subfolders
            If vOFolder2.Name = vName Then
                ActiveWorkbook.SaveAs vOFolder2.Path & "\" & vName & ".xlsm"
                GoTo EX
            End If
        Next
    Else
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & vName & ".xlsm"
    End If
EX: Set vFSO = Nothing
    ActiveWorkbook.SaveAs vFileName
    Application.DisplayAlerts = True
    
End Sub
 

EXCEL MAX

Active Member
Joined
Nov 11, 2020
Messages
392
Office Version
  1. 2016
Platform
  1. Windows
If you want to create folder with name from "D5" and
save file with same name in this folder, replace this part of code...
VBA Code:
    Else
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & vName & ".xlsm"
    End If
with this...
VBA Code:
    Else
        MkDir ActiveWorkbook.Path & "\" & vName
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" _
            & vName & "\" & vName & ".xlsm"
    End If
 
Solution

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,742
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Thank you Excel Max this is going to be a huge help :)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,580
Messages
5,637,211
Members
416,961
Latest member
sigrid6940

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