Save Current WS as Workbook to Selected File Path

[zljordan]

Hello All,

I am having a hard time figuring out how to create a macro that will allow me to save a current worksheet as a .xlsx file in a filepath that has been selected on the sheet.

I currently have a combo box where I select the client's name on a WS named "Save". Once a name is selected, their corresponding file path is looked up from a WS named "FilePaths". This also looks up their name from the "FilePaths" WS which creates the desired name of the file I would like to Save As, using the formula =INDEX(ClientName,$B$4,1)&" "&"Form"&" "&TEXT(TODAY(),"mm-dd-yy").

I have attached a copy of the workbook I am using to give you a better understanding of what I am working with. Basically I would like to be able to select a name and save the current worksheet as a new workbook is in the "SaveToPath" named range, and have the new WB saved as the name in "FileNameSave" named range.

Thank you very much for your help.

[gmayor]

Can we assume that the sheet you want to save is your sheet named 'Save'? In that case it seems pretty straightforward. The following will also create the folder if missing, provided the drive U:\ exists. If the drive U is a removable flash drive it would be better to save the file to the C drive.

Option Explicit

Sub Save_ActiveSheet_As_Workbook()
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim strFname As String
    Set xlSheet = ActiveSheet
    Set xlBook = Workbooks.Add
    xlSheet.Copy Before:=xlBook.Sheets(1)
    strFname = xlSheet.Range("SaveToPath") & "\" & xlSheet.Range("FileNameSave") & ".xlsx"
    CreateFolders xlSheet.Range("SaveToPath")
    xlBook.Sheets("Sheet1").Delete
    xlBook.SaveAs strFname
    xlBook.Close
lbl_Exit:
    Exit Sub
End Sub

Private Function CreateFolders(strPath As String)
'Graham Mayor
'Create any missing folders in a named file path
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
    vPath = Split(strPath, "\")
    strPath = vPath(0) & "\"
    For lngPath = 1 To UBound(vPath)
        strPath = strPath & vPath(lngPath) & "\"
        If Not FolderExists(strPath) Then MkDir strPath
    Next lngPath
lbl_Exit:
    Exit Function
End Function

Private Function FolderExists(strFolderName As String) As Boolean
'Graham Mayor
'strFolderName is the name of folder to check
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FolderExists(strFolderName)) Then
        FolderExists = True
    Else
        FolderExists = False
    End If
lbl_Exit:
    Exit Function
End Function

[snb]

Put this macro in the codemodule of sheet2 ("save")
Assign this macro to the 'Drop Down 6' formcontrol.

Sub M_snb()
    ThisWorkbook.SaveCopyAs "U:\clients\client " & [b4] & "\client " & [b4] & " Form " & Format(Date, "mm-dd-yyyy") & ".xlsm"
End Sub

If you want to check/create the folder the file has to be stored in:

Sub M_snb()
    If Dir("U:\clients\client " & [b4]) = "" Then CreateObject("shell.application").Namespace("U:").NewFolder "clients\client " & [b4]

    ThisWorkbook.SaveCopyAs "U:\clients\client " & [b4] & "\client " & [b4] & " Form " & Format(Date, "mm-dd-yyyy") & ".xlsm"
End Sub

[zljordan]

Thank you guys! These worked great! Your help is greatly appreciated.