PDA

View Full Version : Creating an excel Save As button in a workbook.



mcrackin
06-19-2013, 11:31 AM
Hi everyone.

I'm trying to create a SaveAs button in an excel file so that employee's can easily Save workorder documents from a template. The macro needs to have the following attributes:

1. Save the file as "cellvalue_date.xls" (ie. 123456_20130620.xls)
2. Save the file into organized directories by year and month name and create those dirs if they aren't already created (ie. /2013/Jun/123456_20130620.xls)
3. I want the user to be prompted with a customizable message to confirm the SaveAs, and when they click "Yes" (instead of "Cancel"), the document executes the whole SaveAs and restores the document to a blank sheet to start over. This is so people can easily create more than one work order.

Update: Here is my code so far, which I have attempted the first 2 steps and it is working perfectly. I've also coded a little prompt and tied the two together and everything works fine. Now I'm just looking to return to the original template so an employee can begin editing the next work order from the original state.


The code so far:


Sub Button1_Click()
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

strPrompt = "Are you sure you want to save the file and clear the document?" 'message prompt question
strTitle = "Confirmation" 'title of prompt box
iRet = MsgBox(strPrompt, vbYesNo, strTitle)
If iRet = vbNo Then
MsgBox "Please make necessary changes." 'if user clicks no on prompt
Else
Dim newFile As String, fName As String
On Error Resume Next
fName = Sheets("Production Report").Range("G5").Value 'Change A1 to whatever cell you want to appear in the saved file name
newFile = fName & "_" & Format$(Date, "yyyymmdd") & ".xls" 'Change the date to whatever you want ie ddmmyyyy but leave the quotes
MkDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY")
MkDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM")
ChDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM") 'edit the 3 directory names to whatever you use, original string must pre-exist
ActiveWorkbook.SaveAs Filename:=newFile
MsgBox "Your document has been saved. Continue with a new work order or exit to finish." 'if user clicks yes on prompt
End If
End Sub

thedon32
06-19-2013, 12:39 PM
Try using

Application.Commandbars.FindControl(ID:=748).Execute

This will bring up the Save AS prompt when you assign it to a command button

mcrackin
06-19-2013, 12:46 PM
I'm way too newbie to know what that even means

thedon32
06-19-2013, 12:58 PM
It's ok,

In layman's terms it basically means your calling the standard 'Save As' function in excel,

mcrackin
06-19-2013, 01:11 PM
So replace

ActiveWorkbook.SaveAs

with

Application.Commandbars.FindControl(ID:=748).Execute

?

mcrackin
06-19-2013, 01:37 PM
Here's my new code

Sub Button1_Click()

Dim newFile As String, fName As String
fName = Range("A1").Value 'Change A1 to whatever cell you want to appear in the saved file name
newFile = fName & Format$(Date, "yyyymmdd") & ".xls" 'Change the date to whatever you want ie ddmmyyyy but leave the quotes
MkDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM")
ChDir _
"C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM") 'edit the directory name to whatever you want
ActiveWorkbook.SaveAs Filename:=newFile
End Sub

It saves the file and creates the dir, but if the dir already exists an error occurs.

thedon32
06-19-2013, 01:44 PM
Yeah Just replace the
ActiveWorkbook.SaveAs with Application.Commandbars.FindControl(ID:=748).Execute as it forces the system to bring up the Save As prompt, give it a shot.

mcrackin
06-19-2013, 02:03 PM
When I do that I get

Compile error:

Wrong number of arguments or invalid property assignment

mcrackin
06-19-2013, 02:09 PM
New code is in the title message, steps 1,2 work perfectly. Now I need help on doing the message dialogue/reset document. Please!

thedon32
06-19-2013, 02:22 PM
How do the users enter the data, if it's text boxes, just enter something like this for all the textboxes you want to reset.

Activeworkbook.Sheets("Sheet1").txt_test = ""

If it's on the spreadsheet cells, exchange the .txt_test to .Range("A1:Z30") = "", something like that

mcrackin
06-19-2013, 02:26 PM
Ok so I've just combined the two codes and everything is working so far.

The file directory path is created if it isn't already, the file saves as the proper title. As well, a message dialogue box appears asking the user to confirm the save. The only thing I need to do now is to exit the 'saved as' document and restore the original 'template' all in one action when I confirm my save.

Here is the total code:

Sub Button1_Click()
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

' Promt
strPrompt = "Are you sure you want to save the file and clear the document?"

' Dialog's Title
strTitle = "Confirmation"

'Display MessageBox
iRet = MsgBox(strPrompt, vbYesNo, strTitle)

' Check pressed button
If iRet = vbNo Then
MsgBox "Please make necessary changes."
Else
Dim newFile As String, fName As String
On Error Resume Next
fName = Sheets("Production Report").Range("G5").Value 'Change A1 to whatever cell you want to appear in the saved file name
newFile = fName & "_" & Format$(Date, "yyyymmdd") & ".xls" 'Change the date to whatever you want ie ddmmyyyy but leave the quotes
MkDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY")
MkDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM")
ChDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM") 'edit the directory name to whatever you want
ActiveWorkbook.SaveAs Filename:=newFile
MsgBox "Your document has been saved."
End If
End Sub

SamT
06-19-2013, 07:25 PM
Try this
Else
Dim newFile As String, fName As String
TemplatePath As String
TemplateName As String
On Error Resume Next
fName = Sheets("Production Report").Range("G5").Value 'Change A1 to whatever cell you want to appear in the saved file name
newFile = fName & "_" & Format$(Date, "yyyymmdd") & ".xls" 'Change the date to whatever you want ie ddmmyyyy but leave the quotes
MkDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY")
MkDir "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM")
NewPath = "C:\Users\McRackin\Desktop\Dave\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM") & "\" 'Add ther final slash to the directory name
ActiveWorkbook.SaveAs Filename:=NewPath & newFile
MsgBox "Your document has been saved."
Workbooks(newFile).Close
Workbooks.Open (TemplatePath & "\" & TemplateName) 'Edit as needed
End If

mcrackin
06-19-2013, 08:07 PM
So I've added in those 2 last lines of code and edited a couple more things.

Sub Button1_Click()
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
Dim newFile As String, fName As String, fPath As String, tPath As String

strPrompt = "Are you sure you want to save the file as " & Sheets("Production Report").Range("G5").Value & "_" & Format$(Date, "yyyymmdd") & ".xls" & " ? This will clear the data for the next production run." 'message prompt question
strTitle = "Confirmation" 'title of prompt box
iRet = MsgBox(strPrompt, vbYesNo, strTitle)
If iRet = vbNo Then
MsgBox "Not saved. Please make necessary changes." 'if user clicks no on prompt
Else

On Error Resume Next
fName = Sheets("Production Report").Range("G5").Value 'Change A1 to whatever cell you want to appear in the saved file name
fPath = "C:\Users\McRackin\Desktop\Dave\" 'Edit the directory path, this path MUST pre-exist
tPath = "SaveAs_AndReset_Template2.xlsm" 'template file name
newFile = fName & "_" & Format$(Date, "yyyymmdd") & ".xls" 'Change the date to whatever you want ie ddmmyyyy but leave the quotes
MkDir fPath & Format(Date, "YYYY")
MkDir fPath & Format(Date, "YYYY") & "\" & Format(Date, "MMM")
ChDir fPath & Format(Date, "YYYY") & "\" & Format(Date, "MMM")
ActiveWorkbook.SaveAs Filename:=newFile
MsgBox "Your document has been saved as " & fName & "_" & Format$(Date, "yyyymmdd") & ".xls" & " to " & fPath & Format(Date, "YYYY") & "\" & Format(Date, "MMM") & ". Continue with a new work order or exit to finish." 'if user clicks yes on prompt

Workbooks(newFile).Close
Workbooks.Open ("fPath & tPath") 'this should open the template after save

End If
End Sub

The file saves normally and creates directories as needed then it closes the document. Nothing opens up once the page closes.

SamT
06-20-2013, 05:27 AM
Put this in a new workbook and run it to see what happens
Sub test()
Dim newFile As String, fName As String, fPath As String, tPath As String

fPath = "C:\Users\McRackin\Desktop\Dave\" 'Edit the directory path, this path MUST pre-exist
tPath = "SaveAs_AndReset_Template2.xlsm" 'template file name
Workbooks.Open ("fPath & tPath") 'this should open the template after save

End Sub


Uuh. Remove the quotes in ("fPath & tPath")