PDA

View Full Version : [SOLVED] Save Current WS as Workbook to Selected File Path



zljordan
12-11-2015, 11:02 AM
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
12-12-2015, 03:18 AM
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
12-12-2015, 08:53 AM
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
12-15-2015, 07:35 AM
Thank you guys! These worked great! Your help is greatly appreciated.