How to browse for save directory? - excel

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

Related

Conver to XLSM then import module - error 91

Why am I getting object not set error? Seems to be on this line with debug?
xlsmTarget.VBProject.VBComponents.Import "C:\New Name Test\Testv3\CreateUniqueContainers.bas"
However target seems to be set, what have I done wrong?
Sub ConvertXLSFilesToXLSM()
Dim Path As String
Dim DestPath As String
Dim xlsmTarget As Workbook
Const ModulePath As String = "C:\New Name Test\Testv3\CreateUniqueContainers.bas"
Path = "C:\New Name Test\Testv3\Files\"
DestPath = "C:\New Name Test\Testv3\Files\"
WorkFile = Dir(myPath & "*.xls")
Do While WorkFile <> ""
If Right(WorkFile, 4) <> "xlsm" Then
Workbooks.Open Filename:=Path & "\" & WorkFile
ActiveWorkbook.SaveAs Filename:= _
DestPath & WorkFile & ".xlsm",
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
xlsmTarget.VBProject.VBComponents.Import ModulePath
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
WorkFile = Dir()
Loop
End Sub
Option Explicit
Sub ConvertXLSFilesToXLSM()
Const FOLDER = "C:\New Name Test\Testv3\"
Const MODNAME = "CreateUniqueContainers.bas"
Dim SrcPath As String, DestPath As String
Dim SrcFile As String, DestFile As String
Dim n As Long
SrcPath = FOLDER & "Files\"
DestPath = FOLDER & "Files\"
SrcFile = Dir(SrcPath & "*.xls*")
Do While SrcFile <> ""
If Right(SrcFile, 4) <> "xlsm" Then
Debug.Print SrcFile
Workbooks.Open Filename:=SrcPath & "\" & SrcFile
' replace .xls or .xlsx with .xlsm
DestFile = DestPath & Split(SrcFile, ".")(0) & ".xlsm"
' save with new name
With ActiveWorkbook
.SaveAs Filename:=DestFile, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
' import module and save
.VBProject.VBComponents.Import FOLDER & MODNAME
.Save
.Close
End With
n = n + 1
End If
SrcFile = Dir()
Loop
MsgBox n & " files created", vbInformation
End Sub
You need to actually set your variable, and use it. Also, don't rely on Active*
Sub ConvertXLSFilesToXLSM()
Dim Path As String
Dim DestPath As String
Dim xlsmTarget As Workbook
Const ModulePath As String = "C:\New Name Test\Testv3\CreateUniqueContainers.bas"
Path = "C:\New Name Test\Testv3\Files\"
DestPath = "C:\New Name Test\Testv3\Files\"
WorkFile = Dir(Path & "*.xls")
Do While WorkFile <> ""
If Right(WorkFile, 4) <> "xlsm" Then
Set xlsmTarget = Workbooks.Open(Path & WorkFile)
xlsmTarget.SaveAs _
Filename:=DestPath & replace(WorkFile, ".xls", ".xlsm"), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
xlsmTarget.VBProject.VBComponents.Import ModulePath
'xlsmTarget.Save
xlsmTarget.Close, True
End If
WorkFile = Dir()
Loop
End Sub

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

Save As path to original form location - VBA

I'm trying to get my Save As path to open up as the same folder the original document was opened from. For example, if the file was in public/forms I want it prompt save as in public/forms. Currently it is defaulting to mypc/documents. This is my code:
Dim IntialName As String
Dim fileSaveName As Variant
InitialName = Range("d1") & "_" & "#" & Range("l1") & "-" & "RW" &
Range("q1")
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _
filefilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fileSaveName = False Then
Exit Sub
End If
If Not fileSaveName = False Then
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path &
fileSaveName
Else
On Error Resume Next
If Err.Number = 1004 Then
On Error GoTo 0
Else
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path &
fileSaveName
End If
End If
Thanks!
The code below will save to the file name you've used. I've made it reference the ranges on Sheet1 rather than whichever sheet is currently active when your execute the code. Change the sheet name as required.
It will also open to the folder that the file containing the code is in (ThisWorkbook).
Change this to ActiveWorkbook or any other path as required.
Sub Test1()
Dim InitialName As String
With ThisWorkbook.Worksheets("Sheet1")
InitialName = .Range("D1") & "_" & "#" & .Range("L1") & "-" & "RW" & .Range("Q1")
InitialName = ThisWorkbook.Path & "\" & InitialName
End With
InitialName = Application.GetSaveAsFilename(InitialName, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If Not InitialName = "False" Then
ThisWorkbook.SaveAs InitialName
End If
End Sub
Assuming that InitialName contains only a filename without path, change the parameter InitialFileName to
Application.GetSaveAsFilename(InitialFileName:= thisWorkbook.Path & "\" & InitialName, ...
I think this is what you want:
File filter can take a full folder in the initial path, so you can assign it based on the workbooks path
Dim InitialName As String
Dim fileSaveName As Variant
Dim FilePath, FileOnly, PathOnly As String
FilePath = ThisWorkbook.FullName
FileOnly = ThisWorkbook.Name
PathOnly = Left(FilePath, Len(FilePath) - Len(FileOnly))
InitialName = PathOnly & "\" & Range("d1") & "_" & "#" & Range("l1") & "-" & "RW" &
Range("q1")
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _
filefilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fileSaveName = False Then
Exit Sub
End If
If Not fileSaveName = False Then
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & fileSaveName
Else
On Error Resume Next
If Err.Number = 1004 Then
On Error GoTo 0
Else
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & fileSaveName
End If
End If
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _
filefilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")

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

Resources