I have an excel document that a worker has to fill in the information. After that I made a macro that saves the file in 2 different folders and prints it. My problem is the naming of the file. How can I make it that it names the file for example
QualityReportN where N is a number or exact date_time(with seconds)
here is the code so far:
`Sub PrintSave()
'
' PrintSave Macro
'
' Print on default printer save
' Save in two place:
' 1.Specific folder on desktop (named quality cards)
' 2.Network server (location eg. \\HOMEGROUP\QualityCards\)
'
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Logical\Desktop\EXEL\QualityReprotN.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ChDir "C:\Users\Logical\Desktop\New folder"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Logical\Desktop\Network\QualityReportN2.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
End Sub`
You can use the Now() function
Sub PrintSave()
'
' PrintSave Macro
'
' Print on default printer save
' Save in two place:
' 1.Specific folder on desktop (named quality cards)
' 2.Network server (location eg. \\HOMEGROUP\QualityCards\)
'
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Logical\Desktop\EXEL\QualityReprotN" & format(now(),"yyddmm_hhmmss") & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ChDir "C:\Users\Logical\Desktop\New folder"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Logical\Desktop\Network\QualityReportN2" & format(now(),"yyddmm_hhmmss") & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
End Sub
EDIT:
Check out the VBA Library for some other formatting! Link
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Logical\Desktop\Network\QualityReportN" & format(now(),"yyddmm_hhmmss") & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Related
I am not the best at VBA and a third-party programme has suddenly stopped working strangely. I am attempting to save as csv and save as 97-2003 excel file.
This was previously working but now I am receiving a Error 1004 message. Can anybody please help me?
Application.DisplayAlerts = False
xls = ActiveWorkbook.FullName
Length = Len(xls) - 3
CSV = Left(xls, Length) & "csv"
dlist = Left(xls, Length - 1)
ActiveWorkbook.SaveAs Filename:= _
CSV, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
xls, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveSheet.Name = "TITLEBLOCK_DRAWING LIST"
ActiveCell.Select
MsgBox "CSV and XLS files saved"
Hope this helps...
Sub SaveTwoFileTypes()
Dim xlsFileName As String
Dim lengthXlsFileName As Integer
Dim csvFileName As String
Dim dlist As String
Application.DisplayAlerts = False
'Get workbook name (e.g. "https://d.docs.live.net/somealpanumericstring/Documents/Book2.xls")
xlsFileName = ActiveWorkbook.FullName
'Get length of name (e.g. 60), then subtract 4 for the period and 3-digit extension
lengthXlsFileName = Len(xlsFileName) - 4
'Tack on the .csv extension after "https://d.docs.live.net/somealpanumericstring/Documents/Book2"
csvFileName = Left(xlsFileName, lengthXlsFileName) & ".csv"
'No idea why this is here...
dlist = Left(xlsFileName, lengthXlsFileName - 1)
'Save both formats
ActiveWorkbook.SaveAs Filename:= _
csvFileName, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
xlsFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.DisplayAlerts = True
'Name the active worksheet
ActiveSheet.Name = "TITLEBLOCK_DRAWING LIST"
ActiveCell.Select
'Display a message box with this text
MsgBox "CSV and XLS files saved"
End Sub
As title suggests I have reworked a VBA code that basically runs every hour on the hour (or when it initially gets started). It refreshes the connection and then recalculates the sheets, PDFs the file and saves in 3 separate file locations. It's a pretty basic code but I can't get it to run consistently. Usually it PDFs 3-4 times (3-4 hours) before I start getting a PDF of blank pages and excel has to be forced closed and restarted. Then it runs fine again. Sometimes but not all the time I see the "Not enough resources to display" message from excel. Any suggestions would be greatly appreciated.
Sub RecalcPDF()
Application.ScreenUpdating = False
On Error Resume Next
'looks to find data in the table, writes the message, sends the message, and tells the timer to reset
Application.OnTime Sheets("Manual Inputs").Range("A28") + Sheets("Manual Inputs").Range("A27"),
"RecalcPDF", Schedule:=False
Application.Calculation = xlManual
Sheets("Manual Inputs").Range("A1") = Now
Sheets("Manual Inputs").Select
Sheets("Manual Inputs").Activate
ActiveSheet.Calculate
Application.Wait (Now + TimeValue("0:00:03"))
ActiveWorkbook.RefreshAll
Application.Calculate
Dim FileName As String
Dim Path As String
FileName = Sheets("Manual Inputs").Range("D44")
Path = Sheets("Manual Inputs").Range("D43")
'## Add the PATH and EXTENSION to the filename
FileName = Path & FileName & ".pdf"
FileName2 = Sheets("Manual Inputs").Range("D47")
Path2 = Sheets("Manual Inputs").Range("D46")
'## Add the PATH and EXTENSION to the filename
FileName2 = Path2 & FileName2 & ".pdf"
FileName3 = Sheets("Manual Inputs").Range("D50")
Path3 = Sheets("Manual Inputs").Range("D49")
'## Add the PATH and EXTENSION to the filename
FileName3 = Path3 & FileName3 & ".pdf"
With Sheets(Array("Daily Dose Display", "Station")).Select
Sheets("Daily Dose Display").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName2, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName3, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Application.OnTime Sheets("Manual Inputs").Range("A28") + Sheets("Manual Inputs").Range("A27"),
"RecalcPDF", Schedule:=True
Application.ScreenUpdating = True
End Sub
Here is a very basic logging implementation you can try.
Public Sub WriteLog(ByVal msg As String)
Dim fh As Integer
fh = FreeFile
Open "C:\Users\user\Documents\application.log" For Append As #fh
Print #fh, Format(Now, "mm/dd/yyyy HH:nn:ss> ") & msg
Close #fh
End Sub
Then you might use it like this
WriteLog "RecalcPDF: Exporting sheet " & ActiveSheet.Name & " to file " & FileName
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
I have wrote a code to print excel file to .PDF file with the page setups parameters.And also it eliminates the need of having a prompt dialog box also.
But I need to know if I need to name the .PDF file as same as the excel file name with below code but not the same destination path.As an example:= if excel file name is "Quality Report 1411185623689" This file is generated by a system therefore its name is changed everyday.
How do I solve this?
Sub Save_As_PDF()
With ActiveSheet.PageSetup
.Orientation=xlLandscape
.Zoom=16
End With
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:="C\:Desktop\Reports\Same as excel file name", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Exit Sub
Untested, but assuming you want to name the PDF the same as the Excel file (ignoring file extension), but in a different folder (say some folder/directory called "C\:Desktop\Reports\" for example):
Option explicit
Sub SaveAsPDF()
Dim folderPath as string
folderPath = "C\:Desktop\Reports\" ' Change to whatever folder, but make sure it ends with a \
If len(dir$(folderPath, vbDirectory)) = 0 then
Msgbox("'" & folderPath & "' is not a valid/existing directory. Abandoning export. Code will stop running now.")
Exit sub
End if
Dim Filename as string
Filename = left$(Thisworkbook.name, instrrev(Thisworkbook.name, ".", -1, vbbinarycompare) -1) & ".pdf"
With ActiveSheet.PageSetup
.Orientation=xlLandscape
.Zoom=16
End With
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=folderPath & filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Exit Sub
I have the following macro to create a folder within the folder where the Excel file is:
Sub Folder_Test()
If Dir(ThisWorkbook.Path & "\" & "Folder_01", vbDirectory) = "Folder_01" Then
MsgBox "Folder already exists!"
Else
MkDir Application.ThisWorkbook.Path & "\" & "Folder_01"
End If
End Sub
And I have the following macro to create a PDF file:
Sub Button_PDF_200()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & "test.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Now I want that the PDF file which is created in the second macro will be saved in the folder which is created in the first macro.
Do you have any idea how I can do this?
Maybe just that?
Sub Button_PDF_200()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & "Folder_01" & "\" & "test.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
That is changing the Filename argument within the sub Button_PDF_200 from
ThisWorkbook.Path & "\" & "test.pdf"
to
ThisWorkbook.Path & "\" & "Folder_01" & "\" & "test.pdf"
..
Hi Michi,
also you can try something like this:
pdfName = ActiveSheet.Range("T1")
ChDir "C:\Temp\" 'This is where youo set a defult file path.
fileSaveName = Application.GetSaveAsFilename(pdfName, _
fileFilter:="PDF Files (*.pdf), *.pdf")
If fileSaveName <> False Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
fileSaveName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End If
MsgBox "File Saved to" & " " & fileSaveName
Have fun!
I tried to search and put together a code to fit my purpose.
Sub save()
ActiveWorkbook.SaveAS Filename:="C:\-docs\cmat\Desktop\New folder\ck.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
How to edit this to:
Instead of naming the saved file ck.xls, generate the filename from the worksheet cells C5 and C8, with a space in the middle.
try
Sub save()
ActiveWorkbook.SaveAS Filename:="C:\-docs\cmat\Desktop\New folder\" & Range("C5").Text & chr(32) & Range("C8").Text &".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
If you want to save the workbook with the macros use the below code
Sub save()
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Desktop\" & Range("C5").Text & Chr(32) & Range("C8").Text & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
if you want to save workbook with no macros and no pop-up use this
Sub save()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Desktop\" & Range("C5").Text & Chr(32) & Range("C8").Text & ".xls", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
End Sub
Ok, at that time got it done with the help of a friend and the code looks like this.
Sub Saving()
Dim part1 As String
Dim part2 As String
part1 = Range("C5").Value
part2 = Range("C8").Value
ActiveWorkbook.SaveAs Filename:= _
"C:\-docs\cmat\Desktop\pieteikumi\" & part1 & " " & part2 & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
How do I edit this part (FileFormat:= _ xlOpenXMLWorkbookMacroEnabled) for it to save as Excel 97-2013 Workbook, have tried several variations with no success.
Thankyou
Seems, that I found the solution, but my idea is flawed. By doing this FileFormat:= _ xlOpenXMLWorkbook, it drops out a popup saying, the you cannot save this workbook as a file without Macro enabled. So, is this impossible?