I found code online that opens a Save As dialog to a location on a drive.
When you click "save" the file does not save.
Dim varResult As Variant
'displays the save file dialog
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xlsx), *.xlsx", Title:="Save PO", _
InitialFileName:="\\showdog\service\Service_job_PO\")
'checks to make sure the user hasn't canceled the dialog
If varResult <> False Then
Exit Sub
End If
You have to actually explicitly tell Excel to save the workbook.
Sub Mac2()
Dim varResult As Variant
Dim ActBook As Workbook
'displays the save file dialog
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xlsx), *.xlsx", Title:="Save PO", _
InitialFileName:="\\showdog\service\Service_job_PO\")
'checks to make sure the user hasn't canceled the dialog
If varResult <> False Then
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlWorkbookNormal
Exit Sub
End If
End Sub
Using the GetSaveAsFilename only gets the path of the file to save, whereas the SaveAs method actually saves the workbook.
Upon some consideration, I might suggest using the SaveCopyAs method instead of simply SaveAs. As the name suggests, this will leave your original workbook in tact and save off a copy. To do this is a rather simply modification.
You would replace
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlWorkbookNormal
With
ActiveWorkbook.SaveCopyAs Filename:=varResult
One final consideration I would add is that if you save your macro-enabled workbook as a .xlsx (either by SaveAs or the SaveCopyAs) then you will lose the macros, either in your original workbook if you use SaveAs or in the copy that is saved if you use SaveCopyAs. I would consider saving the file as a .xlsm instead, if you need macros to be available.
I prefer to use the shortest code:
Application.Dialogs(xlDialogSaveAs).Show ("c:\my_folder\")
It's the standard Excel save dialog.
It has several parameters (not named), you may need them:
Dim strFilename As String: strFilename = "report1"
Dim strFolder As String: strFolder = "C:\temp\" 'initial directory - NOTE: Only works if file has not yet been saved!
Dim xlfFileFormat As XlFileFormat: xlfFileFormat = XlFileFormat.xlOpenXMLWorkbook 'or replace by other XlFileFormat
Dim strPassword As String: 'strPassword = "password" 'The password with which to protect the file - if any
Dim booBackup As Boolean: 'booBackup = True '(Whether to create a backup of the file.)
Dim strWriteReservationPassword As String: 'strWriteReservationPassword = "password2" ' (The write-reservation password of the file.)
Dim booReadOnlyRecommendation As Boolean: booReadOnlyRecommendation = False '(Whether to recommend to the user that the file be opened in read-only mode.)
Dim booWorkbookSaved As Boolean ' true if file saved, false if dialog canceled
If Len(strFolder) > 0 Then ChDir strFolder
booWorkbookSaved = Application.Dialogs(xlDialogSaveAs).Show(Arg1:=strFilename, Arg2:=xlfFileFormat, Arg3:=strPassword, _
Arg4:=booBackup, Arg5:=strWriteReservationPassword, Arg6:=booReadOnlyRecommendation)
Related
I have a macro-enabled workbook, that has a macro that should save a copy of the file to a new location. I store the name of the original file as a string before saving to the new location, so that I can still reference the original file in the original location. The file still exists there, and the filename string works when I open the file using it, but it doesn't work when I try to do anything else with the string.
The original location is a folder called Source, and the file is copied to the folder called Destination.
The important problem here, is that the folders are located on SharePoint. If the folders are on a local machine it's not an issue.
https://[company].sharepoint.com/sites/[team]/Shared Documents/General/Source/oldVersion.xlsm
https://[company].sharepoint.com/sites/[team]/Shared Documents/General/Destination/newVersion.xlsm
Sub testMove()
FullName = Application.ActiveWorkbook.FullName
ActiveWorkbook.SaveAs "https://[company].sharepoint.com/sites/" _
& "[team]/Shared Documents/General/Destination/newVersion.xlsm", xlOpenXMLWorkbookMacroEnabled
'SetAttr FullName, vbNormal
Workbooks.Open FullName
End Sub
The above code runs just fine, but when you uncomment the setAttr it gets a file not found error.
The goal is to be able to close and/or delete the file in the original location, so SaveCopyAs doesn't quite work for this purpose.
SaveAs and Delete
This works for me. Your feedback is most welcome.
Option Explicit
Sub TestMove()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sFilePath As String: sFilePath = wb.FullName
Dim dFilePath As String: dFilePath = "C:\Users\[username]\OneDrive\" _
& "Documents\Destination\newVersion.xlsm"
Application.DisplayAlerts = False ' overwrite without confirmation
wb.SaveAs dFilePath, xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
'Debug.Print wb.Name ' to prove that it has a new name now
If Len(Dir(sFilePath)) > 0 Then
SetAttr sFilePath, vbNormal
Workbooks.Open sFilePath
'Or:
'Kill sFilePath
Else
MsgBox "File not found.", vbCritical
End If
End Sub
I have a long macro that has 10,000 row files. At the end I try to fileSaveName. It crashes all the time if I just run the macro. I can't trace what is wrong because if I step through I get "Can't enter break mode" anywhere near the save code. Same thing happens if I "run to cursor". And then when I click "Continue" the macro runs to the end just fine.
When I put in a "Debug.Assert" break, the macro runs fine after clicking "Continue".
'Get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'Create default name for saving file
strFile = QuoteNo & " - OEM List"
strPathFile = strPath & strFile
'Save now with Message Box
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=strFile, FileFilter:="Excel workbook (*.xlsx), *.xlsx", Title:="Save with this file name or Create a new name")
If fileSaveName <> False Then
ActiveWorkbook.SaveAs Filename:=fileSaveName
End If
Just step through the file reformatting and filtering and save the file without breaking.
I'm trying to get the 'Save As' dialogue to prompt with the inputted information on a userform and save as a new file. Everything looks like it works and even has the saving/loading icon when I click 'save' but no actual saved file is saved in my folder. Here is my 'Save As' code:
Dim IntialName As String
Dim fileSaveName As Variant
InitialName = Range("d1") & "_" & Range("j1") & "_" & Range("p1")
fileSaveName = Application.GetSaveAsFileName(InitialFileName:=InitialName, _
fileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
Add
ActiveWorkbook.SaveAs fileSaveName, xlFileFormat.xlOpenXMLWorkbookMacroEnabled
after your code to actually save it.
All your code currently does is give you a string so you can save it using that name. You have to do the actual saving yourself.
It is supposed to open the file, save as, copy values, Save as again (final filename), then to delete the first save as. I am using this to achieve a temporary .xlsx file. It works, opens, saves as window comes up, then deletes the Temp file but it is not saving the file before it deletes the temp file.
Code:
Sub PracticeMakesPerfect()
Dim wbMain As Workbook
Dim Alpha As Workbook
Dim Beta As Workbook
Dim sFile As String
Dim PurgeTemp
Application.DisplayAlerts = False
Set wbMain = Workbooks("Macro Tester.xlsm")
Set Alpha = Workbooks.Open("C:\Users\frfcomputer\Desktop\Test.xlsx")
ActiveWorkbook.SaveAs "C:\Users\frfcomputer\Desktop\test\Temp.xlsx"
Set Beta = Workbooks("Temp.xlsx")
wbMain.Sheets("Sheet1").Range("A1").Value = Beta.Sheets("Sheet1").Range("A1").Value
Application.DisplayAlerts = True
Application.GetSaveAsFilename
ActiveWorkbook.Close
'Source File Location
sFile = "C:\Users\frfcomputer\Desktop\test\" & "Temp.xlsx"
'Sets Object
Set PurgeTemp = CreateObject("Scripting.FileSystemObject")
'Checks File Exists or Not
If PurgeTemp.FileExists(sFile) Then
'If file exists, delete the file
PurgeTemp.DeleteFile sFile, True
MsgBox "Deleted The File Successfully", vbInformation, "Done!"
Else
'If file does not exists
MsgBox "Specified File Not Found", vbInformation, "Not Found!"
End If
End Sub
You're asking for a filename to save as with Application.GetSaveAsFilename but you're not putting it to use:
Sub test()
Dim a As String
a = Application.GetSaveAsFilename(FileFilter:="Excel Files, *.xls") 'Ask for a filename to save as.
ThisWorkbook.SaveAs a 'Save the file
End Sub
It's the end of the day, so haven't added everything - check that the result of a isn't FALSE or some other unusable name. There's also various options available under SaveAs.
I found code online that opens a Save As dialog to a location on a drive.
When you click "save" the file does not save.
Dim varResult As Variant
'displays the save file dialog
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xlsx), *.xlsx", Title:="Save PO", _
InitialFileName:="\\showdog\service\Service_job_PO\")
'checks to make sure the user hasn't canceled the dialog
If varResult <> False Then
Exit Sub
End If
You have to actually explicitly tell Excel to save the workbook.
Sub Mac2()
Dim varResult As Variant
Dim ActBook As Workbook
'displays the save file dialog
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xlsx), *.xlsx", Title:="Save PO", _
InitialFileName:="\\showdog\service\Service_job_PO\")
'checks to make sure the user hasn't canceled the dialog
If varResult <> False Then
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlWorkbookNormal
Exit Sub
End If
End Sub
Using the GetSaveAsFilename only gets the path of the file to save, whereas the SaveAs method actually saves the workbook.
Upon some consideration, I might suggest using the SaveCopyAs method instead of simply SaveAs. As the name suggests, this will leave your original workbook in tact and save off a copy. To do this is a rather simply modification.
You would replace
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlWorkbookNormal
With
ActiveWorkbook.SaveCopyAs Filename:=varResult
One final consideration I would add is that if you save your macro-enabled workbook as a .xlsx (either by SaveAs or the SaveCopyAs) then you will lose the macros, either in your original workbook if you use SaveAs or in the copy that is saved if you use SaveCopyAs. I would consider saving the file as a .xlsm instead, if you need macros to be available.
I prefer to use the shortest code:
Application.Dialogs(xlDialogSaveAs).Show ("c:\my_folder\")
It's the standard Excel save dialog.
It has several parameters (not named), you may need them:
Dim strFilename As String: strFilename = "report1"
Dim strFolder As String: strFolder = "C:\temp\" 'initial directory - NOTE: Only works if file has not yet been saved!
Dim xlfFileFormat As XlFileFormat: xlfFileFormat = XlFileFormat.xlOpenXMLWorkbook 'or replace by other XlFileFormat
Dim strPassword As String: 'strPassword = "password" 'The password with which to protect the file - if any
Dim booBackup As Boolean: 'booBackup = True '(Whether to create a backup of the file.)
Dim strWriteReservationPassword As String: 'strWriteReservationPassword = "password2" ' (The write-reservation password of the file.)
Dim booReadOnlyRecommendation As Boolean: booReadOnlyRecommendation = False '(Whether to recommend to the user that the file be opened in read-only mode.)
Dim booWorkbookSaved As Boolean ' true if file saved, false if dialog canceled
If Len(strFolder) > 0 Then ChDir strFolder
booWorkbookSaved = Application.Dialogs(xlDialogSaveAs).Show(Arg1:=strFilename, Arg2:=xlfFileFormat, Arg3:=strPassword, _
Arg4:=booBackup, Arg5:=strWriteReservationPassword, Arg6:=booReadOnlyRecommendation)