save Excel with date in name - vba

I am trying to build a macro that will save my Excel file with the specified name (customer and date).
Not working so far and as I am not very fluent in VBA maybe someone here would be willing to help:
Sub Save()
Sheets("Tool").Unprotect Password:="xxxx"
Dim fclient As String
Dim path As String
fclient = Range("G11").Value
path = Application.ActiveWorkbook.path
fname = "Discount for " & fclient
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname & Format(Now, "DD-MM-YYYY"), FileFormat:=52, CreateBackup:=False
Sheets("Tool").Protect Password:="xxxx"
End Sub

Try using ThisWorkbook instead of Activeworkbook

Rather than putting the Format(Now(DD-MM-YYYY)) directly into your path, you can set the date into a cell in the sheet and then use the cells value as part of the file name the same as you have done for the clients name.
The Date function uses your current system date in the DD/MM/YYYY format rather than DD/MM/YYYY HH:MM:SS which Now uses.
I've adapted this to your code along with a 'find and replace' code to find the "/" in the date and replace it with "_". (NOTE this was simply recorded and could be written better I'm sure.) You could change the underscore to any other valid character for a file name if you wish.
In my test I removed Path as if you omit a path in the file name it will use the current files path.
Sub Save()
Dim fclient As String
Dim tdate As String
Range("G12") = Date
tdate = Range("G12")
fclient = Range("G11")
Cells(12, 7).Replace What:="/", Replacement:="_", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
tdate = Range("G12")
fname = "Discount for " & fclient
ThisWorkbook.SaveAs Filename:="\" & fname & "_" & tdate _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
I've assumed cell G12 is able to contain the date.
Why your original code doesn't work i'm not sure but this is an alternative.

Related

Save Word Doc as contents of a certain Cell

I am trying to set the name of my Word document as the contents of whats in the highlighted cell, given by code; ActiveDocument.Tables(1).Cell(1, 2)
I have to do this for 200+ documents and the name will be in the same spot for all the documents.
This macro selects the desired cell and copies it
ActiveDocument.Tables(1).Cell(1, 2).Select
Selection.Copy
And this one saves the word document as a pdf with the clipboard contents as its name.
Sub rename()
Dim strPath As String
Dim strFileName As String
'set pathname accordingly
strPath = "enter path"
'create the Filename with your selection in Document
strFileName = Trim(Selection.Text) & ".pdf"
ActiveDocument.SaveAs FileName:= _
strPath & strFileName _
, FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False
End Sub
The issue is that the second Macro does not work when I select the entire cell
Only when I select specific text, like below
Any solutions for this?
Many thanks again
Try replacing this line:
strFileName = Trim(Selection.Text) & ".pdf"
With this...
With ActiveDocument.Tables(1).Cell(1,2).Range
strFileName=ActiveDocument.Range(Start:=.Start, End:=.End-1) & ".pdf"
End With
In MS Word last character in a cell is always a special character with ASCII code 7 which mark the end of cell. You need to remove this character before using. There might be several way of doing it. You may replace this character as follows:
strFileName = Replace(ActiveDocument.Tables(1).Cell(1, 2).Range.Text, Chr(7), "") & ".pdf"
Or, you may exclude it as follows:
charCount = ActiveDocument.Tables(1).Cell(1, 2).Range.Characters.Count
strFileName = Left(ActiveDocument.Tables(1).Cell(1, 2).Range.Text, charCount - 1)

Excel/VBA Remove text from ThieWorkbook.Name

I am trying to save a copy of an excel file through use of a marco but amend text after the current file name when saving. I have a macro that works, but it adds the file extension to the file name before I can amend text to it.
EG- my file is named "MyCurrentFile.xlsm", when I save it it adds the date, but keeps names the file "MyCurrentFile.xlsm01-14-16.xlsm".
Can I somehow remove the first .xlsm?
Code:
Sub Save_With_Todays_Date()
'
' Save_With_Todays_Date Macro
' Save a copy of the workbook with todays date at the end.
ThisWorkbook.SaveCopyAs _
Filename:=ThisWorkbook.Path & "\" & _
ThisWorkbook.Name & _
Format(Date, "mm-dd-yy") & ".xlsm"
End Sub
You can use the Workbook.FullName property and parse off the extension.
Dim fpfn as String
fpfn = ThisWorkbook.FullName
ThisWorkbook.SaveCopyAs _
Filename:=Left(fpfn, InStrRev(fpfn, Chr(46)) - 1) & Format(Date, "mm-dd-yy"), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
I would recommend leaving the extension off the Workbook.SaveAs method and let the XlFileFormat Enumeration assign the correct extension. Hardcoding the extension reduces functionality and can result in an incorrect extension being applied to a SaveAs.
ThisWorkbook.Name = Replace(ThisWorkbook.Name, ".xlsm", Format(Date, "mm-dd-yy") & ".xlsm")

Appending Username and Date to Save As in VBA

How can I save the excel file using vba code so that the Username and Date are attached in a macro?
Here is the code that I worked on to try to make it work:
ActiveWorkbook.SaveAs FileName:=(Environ$("Username")) & "_" & Date & "_BKMtracker.xlsx", FileFormat:=xlOpenXMLWorkbook
Try this:-
ActiveWorkbook.SaveAs FileName:=(Environ$("Username")) & "_" & Date & "_BKMtracker.xlsx", FileFormat:=xlOpenXMLWorkbook
With credit to #MatthewD
Sub SaveDocument()
Dim username As String
Dim nowFormated As String
Dim path As String
Dim filename As String
Dim extention As String
username = Environ("Username") & "_" 'gets the username
nowFormated = CStr(Format(now, "yymmdd")) 'or every format you like
path = "D:\" 'Wherever you want to save the file
filename = "_BKMtracker" 'or what you want
extention = ".xlsm" 'for example (with macros, else you have to change the FileFormat too)
ActiveWorkbook.SaveAs filename:=path & username & nowFormated & filname & extention, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Save an Excel file and export it to pdf with a different sheet

I have never written VBA code, but I checked on internet for some information.
My wish is the following: I have an Excel file with 3 sheets. On one of them, I'd like to add one button which can:
Save the totality of my Excel file following this naming convention: [name of a cells of a page]_AP_[date of today].xls.
Save one of the sheets in a .pdf file.
Print 2 of the 3 sheets while adjusting the contents.
I already started something, but I'm really bad at programming:
Public Sub Savefile_Click() 'copie sauvegarde classeur
' save my file following a name
Dim nom As String
Dim chemin As String
Dim wSheet As Worksheet
chemin = "C:\Users\aaa\Desktop"
nom = [Q13].Value & "_" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) _
& ".xlsm"
With ActiveWorkbook
.SaveAs Filename:=chemin & nom
.Close
rep = MsgBox("Fichier excell sauvegardé")
End With
' ... and print my active sheet (where the button will stay)
For Each wSheet In ActiveWorkbook.Worksheets
If wSheet.Visible Then wSheet.PrintOut
Next
'Save my page 'offre' in pdf on my desktop and print it
Worksheets("OFFRE A ENVOYER").Range("A1:i47").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=[Q13].Value & "_Offre de prix", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
After that there will be another option and details, but this is really the base.
1) Save as Excel
Dim nom As String
nom = ThisWorkbook.Sheets(1).Range("Q13").Value & "AP" & Format(Date, "ddmmyyyy") & ".xls"
thisworkbook.saveas sPath & nom 'Define path first, don't forget the \ at the end.
Even better would be to create a named range from range "Q13" and use:
nom = thisworkbook.names("Something").referstorange.value
To make the link dynamic in case you insert a column or row which shifts all your ranges.
2) Save workbook as PDF
ThisWorkbook.ExportAsFixedFormat xlTypePDF, sPath & sFile 'Define here .pdf
3)
"print 2 of the 3sheets with adjusting the contenant of a "
I'm not sure if I get this one...
Print command is given by:
Set oSheet= thisworkbook.sheets(2)
with oSheet.PageSetup
.PrintArea = "$A1$1:$Q$40"
...
'Any other properties: http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/AllpropertiesofPageSetup.htm
end with
oSheet.printout
Which ever way you want to program this in order to retrieve the sheets that you need to print.
You can loop through the sheets with a counter and put if statements to add conditions.
dim oSheet as Excel.worksheet
dim iCnt as integer
For each oSheet in thisworkbook.sheets
iCnt = iCnt + 1
'Include conditions here
If ... then 'Whatever condition
set oSheet = thisworkbook.sheets(iCnt)
'Print
end if
next oSheet
thank you ...i was searching this. this worked very well.
Option Explicit
Sub SvMe() 'Save filename as value of A1 plus the current date
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Range("A1").Value
newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
' Change directory to suit
ChDir _
"C:\Users\user\Desktop" 'YOU MUST Change USER NAME to suit
ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:=newFile
End Sub
this
1. saves my file in pdf format and
2. does not prompt me for attending save as dialog box
3. saves file using cell value in A1 and date stamp

Macro with Save Current date

Is there a way to make a macro to save a file with the current day in the name. I want to save this off everyday with the correct date.
This is what I have as a macro, pretty simple, but I am having issues with getting the current date formula in the file name (if possible)
Sub Save()
ActiveWorkbook.SaveAs Filename:="X:\file06-21-2012\.xlsm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
So tomorrow i would want the marco to save it as file06-22-2012.
Thanks
Like this?
Sub Save()
Dim FilePath As String
Dim NewName As String
FilePath = "X:\": NewName = FilePath & "file" & Format(Date, "MM-DD-YYYY") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=NewName, FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
WIth all due respect to #HeadofCatering's answer, a simpler, more easily readable approach would be this, I think.
Sub Save()
Dim dtDate As Date
dtDate = Date
Dim strFile As String
strFile = "X:\file" & Format(dtDate, "mm-dd-yyyy") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=strFile, FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub