VBA Excel: Save to different directory - excel

I currently use the following to save the file "Book1" with today's date. However, the file automatically saves in the same folder as "Book1". I am trying to save the files into a different directory, I am wondering how I can do that.
Sub filesave()
ActiveWorkbook.SaveAs ("Z:\Henry\test\Book1 " & Format(Now(), "YYYYMMDD") & ".xlsx")
End Sub

You use a folderPicker to allow the user to select their folder of choice. Be aware that the activeworkbook must be an xlsx.
Option Explicit
Public Sub SelectFolder()
Dim sFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
sFolder = .SelectedItems(1)
End If
End With
If sFolder <> vbNullString Then
ActiveWorkbook.SaveAs sFolder & Format$(Now(), "YYYYMMDD") & ".xlsx"
End If
End Sub
Code adapted from here.
A similar version that drops the comparison with vbNullString, courtesy of #JohnyL:
Option Explicit
Public Sub SelectFolder()
Dim sFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
sFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
ActiveWorkbook.SaveAs sFolder & Format$(Now(), "YYYYMMDD") & ".xlsx"
End Sub

You could do something like this.
Sub filesave()
ActiveWorkbook.SaveAs Filename:="Z:\Henry\test\Book1" _
& Format(Now(), "YYYYMMDD") & ".xlsx"
End Sub

Related

Excel VBA - Opened workbook with wildcard or partial match cannot save as copy

I would like to open a workbook using a wildcard or partial name match and save a copy with another name.
However, there is an error -
Always at the " Workbooks(myFolderPath & "" & MyFileName).SaveCopyAs Filename:="NEW NAME.xlsx" " line
Here is my code:
Sub GENERATE()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'If workbook name like "Report Due" then open, if not already opened
Dim MyFileName As Variant
Dim myFolderPath As String
myFolderPath = Application.DefaultFilePath
MyFileName = Dir(myFolderPath & "\" & "Report Due*.xlsx")
If MyFileName <> "" Then
Workbooks.Open (myFolderPath & "\" & MyFileName)
End If
Workbooks(myFolderPath & "\" & MyFileName).SaveCopyAs Filename:="NEW NAME.xlsx"
Workbooks(myFolderPath & "\" & MyFileName).Close SaveChanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I'd be happy to see what's wrong! Many thanks!
Set a reference to the workbook when you open it, then you shouldn't need to use it's name to reference when saving the copy.
Option Explicit
Sub GENERATE()
Dim wb As Workbook
Dim MyFileName As Variant
Dim myFolderPath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'If workbook name like "Report Due" then open, if not already opened
myFolderPath = Application.DefaultFilePath
MyFileName = Dir(myFolderPath & "\" & "Report Due*.xlsx")
If MyFileName <> "" Then
Set wb = Workbooks.Open(myFolderPath & "\" & MyFileName)
wb.SaveCopyAs Filename:="NEW NAME.xlsx"
wb.Close SaveChanges:=False
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

How to save xlsm as xlsx?

I have a xslm file. I want to save the file as xlsx and email.
I am able to SaveCopyAs it as xls file. If I try to save it as xlsx, it does get saved but when I open it, it gives an error.
ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "\MyFileName - " & Format(Date, "mm-dd-yyyy") & ".xlsx"
Excel cannot open the file '...path\MyFileName.xlsx' because the file format or file extension is not valid. Verify that file has not been corrupted and that file extension matches the format of the file
SaveCopyAs does not change the file-type.
You simply cannot save a .xlsm as .xlsx via SaveCopyAs.
EDIT
a workaround is to save a copy which then is changed in type while the old copy will be deleted like:
Dim wb As Workbook, pstr As String
pstr = ActiveWorkbook.Path & "\MyFileName - " & Format(Date, "mm-dd-yyyy") & ".xlsm"
ActiveWorkbook.SaveCopyAs Filename:=y
Set wb = Workbooks.Open(pstr)
wb.SaveAs Left(pstr, Len(pstr) - 1) & "x", 52
wb.Close False
Kill pstr
Try this:
Sub SaveAsXLSX()
ThisWorkbook.Save 'Optional
Application.DisplayAlerts = False
ThisWorkbook.SaveAs ActiveWorkbook.Path & "\MyFileName - " & Format(Date, "mm-dd-yyyy"), 51 '51 = xlsx
Application.DisplayAlerts = True
ThisWorkbook.Close 'Optional
End Sub
All you need to do is SaveAs and change the file format to 51 (xlsx)
If you want to "Save a copy" - SaveAs does practically the same thing - the difference being your currently open file becomes the saved file, but you can simply reopen the old one if you wish and nothing changes.
What you actually want to do is SaveAs a different file type, so use SaveAs.
I This is more readable. TESTED.
Sub SaveXlsmAsXlsx()
Dim wb As Workbook, Filenamepath As String, Filenameext As String, Filenameonly As String, Filepathonly As String
Application.DisplayAlerts = False
Filenamepath = ActiveWorkbook.FullName
Filenameext = ActiveWorkbook.Name
Filenameonly = Replace(Filenameext, ".xlsm", "")
Filepathonly = Replace(Filenamepath, ".xlsm", "")
Set wb = Workbooks.Open(Filenamepath)
'51 = xlsx
wb.SaveAs Filename:=Filepathonly & "_" & Format(Date, "mm-dd-yyyy"), FileFormat:=51
wb.Close True
'Kill- Best not to kill anyone, you might be sorry
ThisWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub
This code add to any module:
Public Sub XLSMtoXLSX(FaylAdi As String)
Dim FullPath As String
Dim wb As Workbook
MsgBox "YOU WILL GET A WARNING AFTER COMPLETED, PLEASE WAIT"
ThisWorkbook.Save
On Error GoTo XETA
'You can change the name of the folder path below
FullPath = "C:\kohne sistem\Excel\VBA\Anbar\temp\" & FaylAdi & ".xlsm"
ThisWorkbook.SaveCopyAs FullPath
Application.DisplayAlerts = False
Set wb = Workbooks.Open(FullPath)
wb.SaveAs Left(FullPath, Len(FullPath) - 1) & "x", 51
wb.Close False
Kill FullPath
Application.DisplayAlerts = True
MsgBox "COMPLETED CORRECTLY"
Exit Sub
XETA: MsgBox "THERE WAS A FAULT SOMEWHERE"
End Sub
Then you can use it like this:
Private Sub CommandButton1_Click()
Call XLSMtoXLSX(Date)
End Sub

Export sheet as new Excel file (values only)

I found code in this discussion which has been extremely helpful for exporting Excel sheets as a new workbook. I've posted the version of the code that I currently use below.
As this code stands, it copies the content of the desired sheet to a new workbook, formulas and all.
Is it possible to modify this code to copy values only to this new workbook?
I appreciate any insight anyone can lend.
Sub ExportXLSX()
'exports desired sheet to new XLSX file
Dim MyPath As String
Dim MyFileName As String
Dim DateString As String
DateString = Format(Now(), "yyyy-mm-dd_hh_mm_ss_AM/PM")
MyFileName = DateString & "_" & "Whatever You Like"
If Not Right(MyFileName, 4) = ".xlsx" Then MyFileName = MyFileName & ".xlsx"
Sheets("Desired Sheet").Copy
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Where should we save this?"
.AllowMultiSelect = False
.InitialFileName = "" '<~~ The start folder path for the file picker.
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"
End With
NextCode:
With ActiveWorkbook
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close False
End With
End Sub
See revised NextCode section for solution:
NextCode:
With ActiveWorkbook
.ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value '<~~ converts contents of XLSX file to values only
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close False
End With

String obtained from FileDialog does not display in message box

I'm trying to display where a file is saved in a message box with the following code:
Sub export()
Dim MyPath As String
Dim MyFileName As String
MyFileName = "MyFileName"
Worksheets("Tab").Copy
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = "Path"
If .Show = -1 Then
GoTo Nextcode1
Else
GoTo Nextcode2
End If
MyPath = .SelectedItems(1) & "\"
End With
Nextcode1:
Block of codes that deals with existing file name.
GoTo Nextcode3
Nextcode2:
Block of codes that deals with cancel.
GoTo Nextcode4
NextCode3:
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs fileName:=MyPath & MyFileName, FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With
Application.DisplayAlerts = True
Worksheets("OtherTab").Activate
MsgBox ("The tab has been exported to " & MyPath & MyFileName & ".")
GoTo NextCode4
NextCode4:
End Sub
However, the message box only displays
The tab has been exported to MyFileName.
With MyPath completely omitted. I tried the following codes
PathName = MyPath & MyFileName
MsgBox ("The tab has been exported to " & PathName & ".")
And
Cstr(MyPath)
MsgBox ("The tab has been exported to " & MyPath & MyFileName & ".")
To no avail. My suspicion is that path name obtained from the msoFileDialogFolderPicker is not a string object but I'm not sure how to deal with it. Help is appreciated!
Ok my bad. The
MyPath = .SelectedItems(1) & "\"
line should have gone under
If .Show = -1 Then

How to browse for save directory?

By clicking a button in Excel, the user exports a specific sheet to a csv with a dynamic filename and the csv is saved in a pre-determined directory.
Instead of saving to a predetermined directory, can users have the browse window to choose a directory to save to?
Sub Export()
Dim MyPath As String
Dim MyFileName As String
MyPath = "C:\importtest"
MyFileName = "MR_Update_" & Sheets("Monthly Review").Range("D3").Value & "_" & Format(Date, "ddmmyyyy")
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets("Export Data").Copy
With ActiveWorkbook
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
.Close False
End With
End Sub
Excel has an inbuilt FileSave Dialog. It is called .GetSaveAsFilename. Use that.
Syntax
expression.GetSaveAsFilename(InitialFilename, FileFilter, FilterIndex, Title, ButtonText)
Usage
Dim fileSaveName As Variant
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.csv), *.csv")
If fileSaveName <> False Then
'
'~~> Your code to save the file here
'
End If
As Patrick suggested, you're looking for the .FileDialog property.
To implement it, try this:
Sub Export()
Dim MyPath As String
Dim MyFileName As String
MyFileName = "MR_Update_" & Sheets("Monthly Review").Range("D3").Value & "_" & Format(Date, "ddmmyyyy")
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets("Export Data").Copy
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = "" '<~~ The start folder path for the file picker.
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"
End With
NextCode:
With ActiveWorkbook
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlCSV,CreateBackup:=False
.Close False
End With
End Sub
Try This......
Sub Export()
Dim MyPath As String
Dim MyFileName As String
MyPath = "C:\importtest"
MyFileName = "MR_Update_" & Sheets("Monthly Review").Range("D3").Value & "_" & Format(Date, "ddmmyyyy")
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets("Export Data").Copy
With ActiveWorkbook
.SaveAs Filename:= _
MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
.Close False
End With
End Sub
Here's a script I've been using lately that I like a lot. Thought I would leave this here:
Sub ExportCSV()
Dim FlSv As Variant
Dim MyFile As String
Dim sh As Worksheet
Dim MyFileName As String
Dim DateString As String
DateString = Format(Now(), "yyyy-mm-dd_hh_mm_ss_AM/PM") '<~~ uses current time from computer clock down to the second
MyFileName = DateString & "_" & "Whatever you like"
Set sh = Sheets("Sheet you'd like to export")
sh.Copy
FlSv = Application.GetSaveAsFilename(MyFileName, fileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Where should we save this?")
If FlSv = False Then GoTo UserCancel Else GoTo UserOK
UserCancel: '<~~ this code is run if the user cancels out the file save dialog
ActiveWorkbook.Close (False)
MsgBox "Export canceled"
Exit Sub
UserOK: '<~~ this code is run if user proceeds with saving the file (clicks the OK button)
MyFile = FlSv
With ActiveWorkbook
.SaveAs (MyFile), FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With
End Sub

Resources