Trying to get Excel to "saveas" a workbook by using the following code:
Sub SaveWorkbook(my_FileName, sFolder)
Dim workbook_Name As String
Dim fName As String
fName = CStr(Range("B9").Value)
workbook_Name = "\" & fName & ".xls"
Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name
End Sub
my_FileName and sFolder are being passed by another function:
Sub ProduceDoc()
MsgBox "Please Select the File that Contains the Document"
my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*,*.xsl*,*.xm*")
sFolder = "C:\Users\" & InputBox("Please type your employee id") & "\Desktop\" & InputBox("What will you name your folder?")
Workbooks.Open (my_FileName)
SaveWorkbook (my_FileName)
End Sub
The subscript error is currently being thrown for the line:
Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name
and I can't figure out why. I'm assuming it's happening because I'm forgetting something simple.
What I've done so far to test:
Verified that my_FileName is successfully being passed to the function SaveWorkbook(), and it is. I was able to open the document specified in function ProduceDoc() and get my_FileName to print in a certain cell within SaveWorkbook()
That's all I have in the toolkit atm. Any thoughts?
Edit: I've now updated the line Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name to show new state, and also sFolder is being called in . It is still giving the same error.
I figured it out.
Everything was formatted correctly in all variables, except for these two lines:
workbook_Name = "\" & fName & ".xls"
Workbooks(my_FileName).SaveAs fileName:=sFolder & workbook_Name
Excel didn't like a few things here, so I tried to make it as basic as I could. I combined the concatenation of sFolder and workbook_Name into one variable, removed ".xls", and added the fileFormat:=xlWorkbookNormal argument into the SaveAs method.
What I think really fixed this is how I called the SaveAs method. Changed that to "ActiveWorkbook" rather than what is was previously.
workbook_Name = sFolder & "\" & fName
ActiveWorkbook.SaveAs fileName:=workbook_Name, fileFormat:=xlWorkbookNormal
It all behaves as expected now!
hope this helps anyone who runs into this in the future!
Related
This is probably a really simple task, but for some reason my code doesnt run. This code has worked for the past few months but when I initiate the command now it doesnt work.
The code that I had used (without any change) is the following:
Sub Copy()
ActiveWorkbook.SaveAs "C:\Users\[File Location]" & "File Name " & Format(Now(), "DD-MMM-YYYY") & ".xlsm", FileFormat:=52
End Sub
Wondering if anyone could provide any advice / tips on how to solve/troubleshoot >.< many thanks in advance.
Here it is broken up a little for you. The Environ() function just gets the user name of whoever is logged in when the code runs.
Replace how File1 is created if you want something else. (you did not include that part in your question)
Sub SaveIt()
Dim SavePath As String
Dim File1 As String
Dim Filename As String
SavePath = "C:\Users\" & Environ("UserName") & "\Desktop\TRD\Run\"
File1 = Split(ActiveWorkbook.Name, ".")(0) ' strip out the file extension
Filename = File1 & " " & Format(Now(), "DD-MMM-YYYY") & ".xlsm"
ActiveWorkbook.SaveAs SavePath & Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
Note: This assumes the folder you are saving it to exists already.
I have a file that is placed in a folder, but the date is unknown to me, is there anyway I can pick it up regardless of the date?
FilePath = "\\0_Received\Business_Level_Report_yyyymmdd.xlsx"
The file name will be for example Business_Level_Report_20200729
The date will be unknown but it is the only file with Business Level Report as its prefix.
Can anyone help with this?
Maybe try this solution here: VBA partial file name
You can likely modify this just a bit to get what you're looking for.
For example, in your case you might try this:
myPath = "\\0_Received\"
fname = Dir(myPath & "Business_Level_Report*")
For example, this code opens the workbook named Business_Level_Report_blah_blah_blah without having to specify blah_blah_blah:
Here's the code if you want to run it, too:
Private Sub whatever()
Dim fname As Variant
Dim myPath As String
myPath = "C:\Users\beckj\"
fname = Dir(myPath & "Business_Level_Report*")
If fname <> "" Then
Workbooks.Open (myPath & fname)
MsgBox "File is open."
Else
MsgBox "ERROR."
End If
End Sub
For taday:
FilePath = "\\0_Received\Business_Level_Report_" & Format(Date, "yyyymmdd") & ".xlsx"
for "07/29/2020"
Dim D as Date
D = cDate("07/29/2020")
FilePath = "\\0_Received\Business_Level_Report_" & Format(D, "yyyymmdd") & ".xlsx"
Or if you do not care about a specific date, you must iterate between the folder workbooks and choose the appropriate one in this way:
If fileName like "*Business_Level_Report########.xlsx" then
FilePath = fileName
End If
I'm modifying a Gantt chart excel template I found online by Vertex42 for added functionality.
One of these modifications is a checkbox inside a sheet called "Config" that, when ticked, creates a backup of the Gantt chart whenever the document is opened.
For some reason, I cannot get this simple task to work.
I've tried using both the Form control and ActiveX control check boxes, with different error messages. As far as I can tell, the Form controls are unrecommended, so I'm using the code below in the ThisWorkbook excel object, based on what I've seen online.
Private Sub Workbook_open()
Dim backupFilename As String
Dim formattedDateTime As String
If Sheets("Config").OLEObjects("AutoBackupCheckbox").Object.Value = True Then
formattedDateTime = Format(Now, "d-MMMM-yyyy, h:mm:ss")
backupfilename = Replace(ActiveWorkbook.Name, ".xlsm", " - backup " & DateTime & ".xlsm")
ActiveWorkbook.SaveCopyAs (backupfilename)
End If
End Sub
This code is getting me the error message whenever I open the document or run the debugger,
Run-time error '1004':
Sorry, we couldn't find the <filename> - backup <day>-<month>-<year>, <hour>:<minute>:<seconds>.xlsm. Is it possible it was moved, renamed or deleted?
Any ideas?
UPDATE: After running the debugger, it's complaining on the ActiveWorkbook.SaveAs line.
UPDATE 2: Changed format of 'backupFilename' to remove the '.xlsm' in the middle.
UPDATE 3: Replaced Date with date/time without slashes, and replaced SaveAs with SaveCopyAs. Updated error message.
The argument for the SaveCopyAs call is missing the path of the file.
Replace code with
Private Sub Workbook_open()
Dim backupFilename As String
Dim formattedDate As String
Dim tempFilename As String
Dim workingPath As String
Dim i As Integer
i = 1
If Sheets("Config").OLEObjects("AutoBackupCheckbox").Object.Value = True Then
formattedDate = Format(Date, "d-MMMM-yyyy, ver " & i)
workingPath = Application.ActiveWorkbook.FullName
backupFilename = Replace(workingPath, ".xlsm", " - backup " & formattedDate & ".xlsm")
tempFilename = Dir(backupFilename)
While tempFilename <> "" ' if file already exists
i = i + 1
formattedDate = Format(Date, "d-MMMM-yyyy, ver " & i)
backupFilename = Replace(workingPath, ".xlsm", " - backup " & formattedDate & ".xlsm")
tempFilename = Dir(backupFilename)
Wend
ActiveWorkbook.SaveCopyAs (backupFilename)
End If
End Sub
I am getting a
Run-time error '1004' Method 'SaveAs' of object '_Workbook' failed.
The code works in excel 2010. I only get this error message in excel 2013.
The error message appears after trying to run the follow line.
ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52
Background:
The spreadsheet is an .xls
When using the Saveas I am changing it to .xlsm
I have tried it with a .xls extension and fileformat 56 and it still falls over.
I am using code from the resources listed in the code.
I am saving the file to the same folder the workbook is in.
The orignal file name is: Financial Report as at month N.xls
The new filename is : Financial Report 1516 as at month 8.xlsm
Sub SaveNewVersion_Excel()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim NewSaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
TestStr = ""
Saved = False
x = 0
NewSaveExt = ".xlsm"
'Version Indicator (change to liking)
VersionExt = "_v"
'Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveWorkbook.FullName
myFileName = "Financial Report " & FileFinancialYear & " as at month " & MonthNumber
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0
'Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52
Exit Sub
End If
'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & NewSaveExt, 52
Saved = True
Else
x = x + 1
End If
Loop
'New version saved
MsgBox "New file version saved (version " & x & ")"
Exit Sub
'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub
Function FileExist(FilePath As String) As Boolean
'PURPOSE: Test to see if a file exists or not
'RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm
Dim TestStr As String
'Test File Path (ie "S:\Reports\Financial Report as at...")
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'Determine if File exists
If TestStr = "" Then
FileExist = False
Else
FileExist = True
End If
End Function
Error reproduction: I was able to reproduce the error when trying to save a workbook with a FileName that already exist.
This could happen because the code checks the existence of a file named with extension SaveExt (using Function FileExist) but then try to save it as a file named with extension NewSaveExt. If these extensions are not the same then it’s possible that the file named with extension NewSaveExt already exist raising the
Run-time error ‘1004’: Method ‘SaveAs’ of object ‘_Workbook’ failed.
However this alert:
A file ‘Financial Report as month .xlsm’ already exist in this
location. Do you want to replace it?.
Should have been displayed before the error 1004
Unfortunately I cannot test the code posted in Excel 2010, but I personally think this behavior is not exclusive of Excel 2013.
Solution: If the objective is to always save the file as xlsm (value of NewSaveExt) then the code should validate the existence of a filename with that extension.
Additional comments about the code posted:
It’s a best practice to declare all variables. These variables are not declared:
TestStr, FileFinancialYear, MonthNumber, myFileName, myArray
These lines are redundant as no need to initialize variables that have not been used as yet, so they are already holding their initialized value.
TestStr = ""; Saved = False; x = 0
Suggest to use constant instead of variables for these (see Variables & Constants)
NewSaveExt = ".xlsm"; VersionExt = "_v"
New workbooks are not detected as the error handler NotSavedYet which is supposed to be triggered when the ActiveWorkbook has not been saved before (i.e. a new workbook) never gets fired as none of the commands between the On Error statements generate an error when dealing with new workbooks (see On Error Statement). If the intention is not to save New Workbooks, as implied by the error handler NotSavedYet, then validate the Path of the ActiveWorkbook, it will be empty if the workbook has not has been saved before.
The FileFinancialYear and MonthNumber variables never get populated.
Suggest to use specific workbook properties for Path and Name instead of FullName (see Workbook Object (Excel))
About the piece referred as Determine Base File Name
a. Programming: There is no need for IF statement, just use the Split function and take the item 0. The Split function returns ”a single-element array containing the entireexpression” when the delimiter is not present in the expression” (i.e. VersionExt and myFileName respectively).
b. Practicality: This piece seems to be redundant, as it’s meant to extract from variable myFileName the filename excluding the version and extension, however there is no such information in the variable as it has been populate just few lines above as:
myFileName = "Financial Report " & FileFinancialYear & " as at month " & MonthNumber
Therefore SaveName is always equal to myFileName
The first version of the file is indexed as 0 instead of 1.
The new indexed version will not always be the last index number + 1. If any of the previous versions is deleted or moved out to another folder as this version is missing the code will assign the missing version index to the latest file saved (see Fig. 1, note that time of the version 3 is newer than versions 4 & 5). Correction of this point requires a more complex approach as such it is not included in the revised code below.
Requirements: Based on the above a revised code is written that complies with the following requirements:
The procedure resides in a standalone workbook.
Files are always saved as xlOpenXMLWorkbookMacroEnabled (Extension xlsm)
New workbooks will not be saved as new versions.
Variables FileFinancialYear and MonthNumber are hardcoded as there is no indication of how they get populated (change as required).
The first time a file is saved and it does not exist in the source folder the file will be saved without version number.
The index of the first version should be 1 (change to 0 if required).
Option Explicit
Sub Wbk_SaveNewVersion_Xlsm()
Const kExt As String = ".xlsm"
Const kVrs As String = "_v"
Dim WbkAct As Workbook
Dim iYear As Integer, bMnth As Byte, sWbkStd As String
Dim sWbkPthNme As String, bVrs As Byte
Rem Set Standard Workbook Name
iYear = 2015 'Update Financial Year as required
bMnth = 9 'Update Month as required
sWbkStd = "Financial Report " & iYear & " as at month " & Format(bMnth, "00")
Rem Validate Active Workbook
Set WbkAct = ActiveWorkbook
If WbkAct.Name = ThisWorkbook.Name Then GoTo HdeThs
If WbkAct.Path = Empty Then GoTo NewWbk
Rem Get Workbook Properties
sWbkPthNme = WbkAct.Path & "\" & sWbkStd
Rem Validate Base File Existance
If Not (Fil_FileExist(sWbkPthNme & kExt)) Then
WbkAct.SaveAs sWbkPthNme & kExt, xlOpenXMLWorkbookMacroEnabled
MsgBox "A new workbook has been created: " & _
vbLf & vbLf & Chr(34) & sWbkStd & kExt & Chr(34), _
vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm"
Exit Sub
End If
Rem Save a New Version
bVrs = 1
sWbkPthNme = sWbkPthNme & kVrs
Do
If Fil_FileExist(sWbkPthNme & bVrs & kExt) Then
bVrs = 1 + bVrs
Else
WbkAct.SaveAs sWbkPthNme & bVrs & kExt, xlOpenXMLWorkbookMacroEnabled
Exit Do
End If
Loop
MsgBox "Version """ & bVrs & """ of workbook: " & _
vbLf & vbLf & Chr(34) & sWbkStd & Chr(34) & " has been created.", _
vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm"
HdeThs:
Call Wbk_Hide(ThisWorkbook)
Exit Sub
NewWbk:
MsgBox "Active Workbook """ & WbkAct.Name & """ has not been saved as yet." & vbLf & _
"A new version cannot be saved!", _
vbApplicationModal + vbCritical, "Workbook - Save New Version - Xlsm"
End Sub
Private Function Fil_FileExist(sFullName As String) As Boolean
Dim sDir As String
Fil_FileExist = (Dir(sFullName) <> Empty)
End Function
Private Sub Wbk_Hide(Wbk As Workbook)
Dim Wnd As Window
For Each Wnd In Wbk.Windows
Wnd.Visible = False
Next
End Sub
I want to use a wildcard to open a workbook stored in the same folder as my macro workbook. In the folder is a file named 302113-401yr-r01.xlsm. Here is my code:
Workbooks.Open filename:=ActiveWorkbook.Path & "\302113*.xlsm"
However, it tells me that there is no such file. Any advice?
We cannot open a file using a wildcard - imagine the chaos if we could!
You'll need to use Dir(ActiveWorkbook.Path & "\302113*.xlsm") to loop through the files that this returns. If there will only be one then just use this function once:
Dim sFound As String
sFound = Dir(ActiveWorkbook.Path & "\302113*.xlsm") 'the first one found
If sFound <> "" Then
Workbooks.Open filename:= ActiveWorkbook.Path & "\" & sFound
End If
Dir Function :tech on the net
From my experience this works if you have the wildcard/asterix as the last symbol in the string and if there is only one file. Try doing:
Workbooks.Open filename:=ActiveWorkbook.Path & "\302113*"
For example I am using:
Workbooks.Open Filename:="X:\business\2014\Easy*"
and it works.
You can open files using the wildcard, but only with UNC paths for some reason.
For example :
Set xlFile = xlObj.WorkBooks.Open("\\yourServerHere\dataAutomation\*.xlsx")
I'm not that experienced yet with Excel but the following works well for me for using wildcards in filenames to open files. This example requires all files to be in the same directory/folder. Yes, it is pretty simplistic.
Sub using_wildcards_to_open_files_in_excel_vba()
Dim mypath As String
Dim sFilename As String
'Suppose you have three files in a folder
' Named blank.xlsx,, ex1_939_account.xlsx, and ex1_opt 5.xlsx
'Manually open the blank.xlsx file
'The following code lines will open the second two files before closing the previously opened file.
ActiveWorkbook.Activate
mypath = ActiveWorkbook.Path
'opening xlsx file with name containing "939" and closing current file
mypath = mypath & "\*939*.xlsx"
'MsgBox mypath 'Checking
sFilename = Dir(mypath)
'MsgBox sFilename 'Checking
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:=sFilename
ActiveWorkbook.Activate
mypath = ActiveWorkbook.Path
'opening xlsx file with name ending in "opt 5" and closing current file
mypath = mypath & "\*opt 5.xlsx"
'MsgBox mypath 'Checking
sFilename = Dir(mypath)
'MsgBox sFilename 'Checking
ActiveWorkbook.Close savechanges:=False
Workbooks.Open Filename:=sFilename
End Sub