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

[tonywatsonhelp]

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 MAX]

Hello Tonywatsonhelp,
here is one quick creaed macro.
I hope so it will be helpful.

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]

If you want to create folder with name from "D5" and
save file with same name in this folder, replace this part of code...

    Else
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & vName & ".xlsm"
    End If

with this...

    Else
        MkDir ActiveWorkbook.Path & "\" & vName
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" _
            & vName & "\" & vName & ".xlsm"
    End If

 

[tonywatsonhelp]

Thank you Excel Max this is going to be a huge help