I am placing a button on an Excel sheet which would save as the current worksheet to a separate file. Following is the code I am using:
Sub SaveWorkbook()
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\username\Downloads\New folder" & ActiveSheet.Name & ".xlsx", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
Here instead of sheet name (ActiveSheet.Name), I want to place the text from the cell (D2:E2, both the cells are merged).
Is it possible to do?
Also here I have explicitly mentioned the path.
Is it possible to make it prompt to choose the path to save it?
While choosing the path, the name can be taken from the cell?
Update:
Sub SelectFolder()
Dim diaFolder As FileDialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:= _
diaFolder & ActiveSheet.[d2] & ".xlsx", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Set diaFolder = Nothing
End Sub
Can you see what is the mistake here? the file is not saving in the selected path.
Replace ActiveSheet.Name with ActiveSheet.[d2] .
That will pull the value from the merged cell.
As far as getting the path from the user, it easy with:
Application.FileDialog(msoFileDialogFolderPicker)
https://stackoverflow.com/a/5975453/3566998
Related
I try to set up a code that will save a excelworksheet in a workbook as a PDF and will extract one other worksheet and saves that one under a different name in the same location. atm my code works except for the part that it saves the file not always to the right location.
I use an excel formula to get the right filepath in cell "Dimensionering!I8". I save the worksheet in the same location as the workbook is allready saved.
In the second part of the code I copy a worksheet to a new workbook so I linked the filepath from the worksheet 'dimensionering' to the worksheet 'offertetekst'.
Sub SAVE()
Dim filename As String
Dim filename1 As String
filename = Range("Dimensionering!C8")
Sheets("offerte stuklijst").Select
ActiveSheet.Range("$A$18:$A$1731").AutoFilter Field:=1, Criteria1:="1"
ActiveWindow.SmallScroll Down:=6
Chdir Range("Dimensionering!I8")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
filename1 = Range("Offerte_tekst!E1491")
Sheets("Offerte_tekst").Select
Sheets("Offerte_tekst").Copy
Chdir Range("Offerte_tekst!E1492")
ActiveWorkbook.SaveAs filename:=filename1 & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=Sheets("Dimensionering").Range("I8").Value & "\" & filename & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
ActiveWorkbook.SaveAs filename:=Sheets("Offerte_tekst").Range("E1492").Value & "\" & filename1 & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
This assumes you don't have backslash in your path cell Dimensionering!I8
I found some VBA code online and have made modifications for what I need. I've run into the one issue of being able to change the path. I was under the impression that:
CurrentFile = ThisWorkbook.FullName
Would call back the full file name including the path to where it is currently saved, but when I run the code it goes to my /Documents (not where the file are saved). Is there a way I can modify the below with a hardcoded path?
Sub SaveWorkbookAsNewFile()
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String
Dim NewFileName As String
NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy")
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName
NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _
"Excel Files 2007 (*.xlsx), *.xlsx," & _
"All files (*.*), *.*"
NewFile = Application.GetSaveAsFilename( _
InitialFileName:=NewFileName, _
fileFilter:=NewFileType)
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs filename:=NewFile, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If
Application.ScreenUpdating = True
End Sub code here
Just a minor tweak or 2 to your code will fix you. I commented your old code so you can see what I changed. You don't want to specify the file format when saving like you were doing as it will always prompt you about compatibility issues with changing the version if you are doing so. Leave it blank and it will just default to the version the sheet is already in. You can edit the C:\ after NewFile= to be whatever you need, just keep it in the quotes.
Alternately, you could change the default save location for excel, though that isn't a VBA fix.
Option Explicit
Sub SaveWorkbookAsNewFile()
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String
Dim NewFileName As String
NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy")
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName
'NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _
' "Excel Files 2007 (*.xlsx), *.xlsx," & _
' "All files (*.*), *.*"
NewFile = "C:\" & NewFileName
'NewFile = Application.GetSaveAsFilename( _
' InitialFileName:=NewFileName, _
' fileFilter:=NewFileType)
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
' ActiveWorkbook.SaveAs Filename:=NewFile, _
' FileFormat:=xlNormal, _
' Password:="", _
' WriteResPassword:="", _
' ReadOnlyRecommended:=False, _
' CreateBackup:=False
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If
Application.ScreenUpdating = True
End Sub
If NewFile <> "" And NewFile <> "False" Then
actsheet.SaveAs ("C:/HardcodedLocationHere.xlsx") ' if this fails, actbook
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If
when I run the code it goes to my /Documents (not where the file are saved)
This is because you've not provided a fully-qualified (full path) to the file, you've just given a Name, so it's opening the dialog with the default location of \Documents.
I prefer the FileDialog object instead of the Application.GetSaveAsFileName method.
Option Explicit
Sub SaveWorkbookAsNewFile()
Dim NewFile As String
Dim NewFileName As String
Dim fdlg as FileDialog
NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy")
Application.ScreenUpdating = False ' Prevents screen refreshing.
Set fdlg = Application.FileDialog(msoFileDialogSaveAs)
fdlg.InitialFileName = ThisWorkbook.Path & Application.PathSeparator & NewFileName
fdlg.Show
If fdlg.SelectedItems.Count <> 1 Then GoTo EarlyExit
'# Gets the new file full path & name
NewFile = fdlg.SelectedItems(1)
ThisWorkbook.SaveCopyAs(NewFile)
EarlyExit:
Application.ScreenUpdating = True
End Sub
I have this code that creates a folder and a saves the actual file in it, but i want that it only saves a copy with only one sheet in it. So that the file with the code works like a template...
You write your stuff and press the button and it saves an .xlsx file with one sheet (the sheet with the form) in the new created folder... so you could do this with hundreds of files an folders.
So in the end it should work like this:
You open the .xlsm file where the code below is in.
You got to sheets one FORM (what should be "exported" later on) and
a list where you copy stuff in the form.
When you filled the form and press the button and it saves the Form
sheet in the new folder as .xlsx and you can continue in the .xlsm
file.
If it's unclear for you please ask.
The code i have now
Sub Macro1()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name
strFilename = Range("D8").Value 'New file name
strDefpath = Application.ActiveWorkbook.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Problem here is i have Names for the forms that are like 1102,1103 an going on like that. the next step is that there are files with the name 1102_1 and 1102_2 and they both should go in the folder 1102 ...
It's a bit out of my knownledge please help me guys :) greets
Now i am using this code below
Problem is that it always closes the xlsm file what really annoyes and when i reopen it it wants to update the file i need to remove that but i don't know how :/... and it only should export/save one special sheet
Private Sub CommandButton1_Click()
Dim strFilename As String, _
strDirname As String, _
strPathname As String, _
strDefpath As String, _
SheetToExport As String, _
WbMaster As Workbook, _
WbCopy As Workbook
On Error Resume Next ' If directory exist goto next line
strDirname = Range("W12").Value ' New directory name
strFilename = Range("D8").Value 'New file name
Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output
strDefpath = WbMaster.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook
WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
WbCopy.Close
End Sub
Be careful on your variable declaration!
The way you did it in your OP (original post) :
strFilename, strDirname and strPathname are declared as Variant and not as String.
You can still use them BUT it'll take much more memory and can be issue if you use them as arguments.
See the code :
Dim strFilename As String, _
strDirname As String, _
strPathname As String, _
strDefpath As String, _
SheetToExport As String, _
WbMaster As Workbook, _
WbCopy As Workbook
On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name
strFilename = Range("D8").Value 'New file name
Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output
strDefpath = WbMaster.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook
WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ClosingWb = MsgBox("Do you wish to close the exported file?",vbYesNo,"Close exported file")
If ClosingWb <> vbNo Then WbCopy.Close
I currently have a VBScript that exports an entire excel worksheet to a PDF. I was wondering if it would be possible to set the script to only export the selected areas. I know this can be done manually, but I've been tasked with automating this process. If achieved, it would make the whole reporting proccess a lot easier. The VBScript that I'm currently using is:
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF version of report has been created."
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
I've already tried replacing the "Set ws = ActiveSheet" to "Selection", and that has yielded no results. Also, as a side note, when selections are sent to a PDF, they appear on separate sheets.Is it possible to put them both on one sheet?
Thanks in advance for any help that you can offer me.
Try setting the Print Area that you want to output to PDF.
I am trying to save an Active sheet in Excel using following VBA:
Application.CutCopyMode = False
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xls"
ActiveWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Activeworkbook.close
but I am having two issues here:
1- When I want to open the file I am encountring with following Message:
Manually opening the file is OK by pressing the Yes but I am going to use the Excel File in GIS software which causing problem because of misunderstanding of format. As you can see it has .xls format
2- the Activeworkbook.close is not functioning since I have to close the Application after running the code by my own!
The first part is very important for me, to understand why this is happening? can you please let me know why?
You are using the wrong file format.
For .xls it is xlExcel8. xlOpenXMLWorkbookMacroEnabled is for .xlsm
Either use this
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & _
Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xls"
ActiveWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlExcel8
or use this
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & _
Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Regarding your 2nd question. Change your code to this
Application.DisplayAlerts = False
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & _
Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xls"
ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlExcel8
With ActiveSheet.UsedRange
.Copy
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
Application.Quit