I need code that saves incrementally numbered versions of a file based on whether similarly named files already exist in a specified folder.
For example,
Check for the prescence of currently open file, say named
"Inv_Dec_2015.xlsx" in a folder named "Reports".
If file exists, check for "Inv_Dec_2015_v1.xlsx" in "Reports".
If file exists, check for "Inv_Dec_2015_v2.xlsx" in "Reports".
If file exists, check for "Inv_Dec_2015_v3.xlsx" in "Reports".
If file does NOT exist, Save currently open file as "Inv_Dec_2015_v3.xlsx"
and so on till any number of versions......
I found the following two pieces of code on Ron de Bruin's website that can be used for something like this and modified it a bit to my purpose, but I don't know how use it to check for pre-existing files.
Would deeply appreciate any help with this.
Sub Rename_Store_Wbk()
Dim sPath As String
' Enter the path at which file is to be stored
sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"
' Check whether the file already exists by calling the FileExist function
If FileExist(sPath) = False Then
ActiveWorkbook.SaveAs Filename:=sPath, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub
Function FileExist(FilePath As String) As Boolean
Dim TestStr As String
'Test File Path (ie "C:\Users\Chris\Reports\Inv_Dec_2015.xlsm")
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
See if the loop I added in here works for you:
Sub Rename_Store_Wbk()
Dim sPath As String
' Enter the path at which file is to be stored
sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"
If Not FileExists(sPath) Then
i = 1
Do
sPath = Left(sPath, Len(sPath) - 5) & "_v" & i & ".xlsx"
i = i + 1
Loop Until FileExists(sPath)
End If
ActiveWorkbook.SaveAs Filename:=sPath, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Related
I have spent my whole morning on this and cannot get it working properly. A simple Excel userform was created asking for a filename. If the file exists in the directory I want it to open. If it does not exist I want a "template" file opened instead. I have the does not exist working properly, however cannot get the "does exist" part working. Please help.
Private Sub CmdEnter_Click()
Dim Path As String
Dim File As String
Path = Range("Search!B1")
File = TxtOrder.Value
'If File exists then open.
If Dir(Path & File & ".xlsm") = Path & File & ".xlsm" Then
Workbooks.Open FileName:=Path & File & ".xlsm"
'If File does not exist then open.
ElseIf Dir(Path & File & ".xlsm") = Error Then
Workbooks.Open FileName:=Path & "QCSFormTrial.xlsm"
End If
'Close Dialog and Close Workbook
Workbooks("QCSLaunch.XLSM").Close SaveChanges:=False
End Sub
Please, try this way:
Private Sub CmdEnter_Click()
Dim Path As String, File As String, wb As Workbook
Path = Range("Search!B1")
File = TxtOrder.value
'If File exists then open.
If dir(Path & File & ".xlsm") <> "" Then
Set wb = Workbooks.Open(Path & File & ".xlsm")
Else 'else, open the other one:
Set wb = Workbooks.Open(Path & "QCSFormTrial.xlsm")
End If
Stop 'check if the workbook has been open and press F5 to let code finishing
wb.Close SaveChanges:=False
End Sub
The issue is that Dir(Path & File & ".xlsm") = Path & File & ".xlsm" is basically saying does the folder path I named equal the folder path I named. The path isn't actually directed at the actual folder in way that will open it.
Try this: https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/
Sub LoopAllFilesInAFolder()
'Loop through all files in a folder
Dim fileName As Variant
fileName = Dir("C:\Users\marks\Documents\")
While fileName <> ""
'Insert the actions to be performed on each file
'This example will print the file name to the immediate window
Debug.Print fileName
'Set the fileName to the next file
fileName = Dir
Wend
End Sub
Or, you can remove the If Then and directly open the file. If the file exists, it will open, if not, it will error. You can use error handling then continue.
I have looked at quite a lot of similar questions, but none of them seem to work for my specific issue.
I have a macro that saves my file with a new name if it encounters a file with the same name.
What keeps happening is that it saves the original file to the correct folder, but then when it encounters the file name the next time I save it, the instanced file gets saved to the same folder as the template rather than the folder that they should go to.
In the example below, my template file is saved in the "M:\Excel\" directory.
It saves the first "TEST" file into the "M:\Excel\SavedVersions\" directory since the file name doesn't exist yet.
Then when I run the macro again to have it automatically save an instanced version (ie - "TESTrev1"), it keeps saving the instanced versions to the "M:\Excel\" directory instead of saving it to the "SavedVersions" subfolder.
Not sure what needs to be changed or done differently to get the instanced versions to save to the correct folder.
Any help would be greatly appreciated!
Thanks in advance! :)
Sub TEST()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
GetNextAvailableName("M:\Excel\SavedVersions\TEST.xlsm")
End Sub
Function GetNextAvailableName(ByVal strPath As String) As String
With CreateObject("Scripting.FileSystemObject")
Dim strFolder As String, strBaseName As String, strExt As String, i As Long
strFolder = .GetParentFolderName("M:\Excel\SavedVersions\")
strBaseName = .GetBaseName("TEST")
strExt = .GetExtensionName(".xlsm")
Do While .FileExists(strPath)
i = i + 1
strPath = .BuildPath(strFolder, strBaseName & "rev" & i & "." & strExt)
Loop
End With
GetNextAvailableName = strPath
End Function
Your code was unnecessarily complex.
Try this simpler version.
Sub TEST()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs fileName:= _
GetNextAvailableName("M:\Excel\SavedVersions\TEST.xlsm")
End Sub
Function GetNextAvailableName(ByVal strPath As String) As String
Dim i as Interger: i = 0
Do Until Len(Dir(strPath)) = 0
i = i + 1
strPath = "M:\Excel\SavedVersions\TESTrev" & i & ".xlsm"
Loop
GetNextAvailableName = strPath
End Function
Keep your code simple. If your path is constant then might as well define a variable for it so that it can be used whenever and whereever you want. This way if there is any change in the path, you have to make the change at only one place.
While saving the file, also specify the FileFormat parameter to avoid problems. You might want to read more about it HERE
Is this what you are trying?
Option Explicit
Const sPath As String = "M:\Excel\SavedVersions\"
Sub Sample()
Dim flName As String
flName = sPath & GetNextAvailableName()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=flName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
Function GetNextAvailableName() As String
Dim i As Integer: i = 1
Dim newFile As String
newFile = "TestRev" & i & ".xlsm"
Do Until Dir(sPath & newFile) = ""
i = i + 1
newFile = "TestRev" & i & ".xlsm"
Loop
GetNextAvailableName = newFile
End Function
I randomly create a new folder on my desktop, in this folder I have one template file with .xlsm extension, which contains my VBA code. Meanwhile I have several csv files saved in the same folder with my raw data.
The purpose is looping through all those csv files one by one, open it, and copy some data and paste to my template file(I know how to do this part) from it and close it after all operations are done.
Currently I meet a problem about how to loop through my folder and open those csv one by one. I didn't set a specific folder name, since I want to share it with other people to use,therefore I use Application.ActiveWorkbook.Path to get the path for my current folder.
Here is my code:
Option Explicit
Sub Range_End_Method()
Dim Dir As String
Dim i As String
Application.ScreenUpdating = False
Dir = Application.ActiveWorkbook.Path & "\"
For Each i In Dir.Files
Debug.Print i.Name
If (i.Name Like "*.csv") Then
Workbooks.Open (i.Path)
End If
Next
End Sub
I'm guessing you want to use the Dir function. To use that, make a call to it, specifying folder and file type in the first call, then call it empty until it returns an empty string. Like this:
Folder = Dir(Application.ActiveWorkbook.Path & "\*.csv")
Do While Folder <> ""
Debug.Print Folder
Workbooks.Open Folder
Folder = Dir()
Loop
You can use this function and macro.
Juste replace MsgBox (myFile + "OK") by the action you want to execute.
FUNCTION
Function ClasseurOuvert(NomFich)
On Error Resume Next
Workbooks(NomFich).Activate
If Err <> 0 Then Workbooks.Open FileName:=NomFich
On Error GoTo 0
End Function
MACRO
Sub LoopFiles()
Dim myPath As String, myFile As String
myPath = Application.ActiveWorkbook.Path & "\"
myFile = Dir(myPath & "\*.*")
Do While myFile <> "" And myFile Like "*.csv"
Call ClasseurOuvert(myPath & "\" & myFile)
With Workbooks(myFile)
MsgBox (myFile + "OK")
End With
Workbooks(myFile).Save
Workbooks(myFile).Close
myFile = Dir()
Loop
End Sub
I am trying to make the following code work for saving a file name in a certain format. I would like it to save in the folder the file was opened up in. the file would change it's name to a new month name. I have got most of it working, such as directory selection and filename and for it to save, however, if there is already a file with the same name or if someone selects no or cancel it gives an error. I have tried various ways of trying to get around it but now I'm at a loss. I have 2 codes they both are supposed to do the same thing, just variations.
Sub saving1()
' Saves the file under a new name based on the new month date.
Dim NewFilename As String
Dim tempnm
Dim loc ' variable for file location
loc = Application.ThisWorkbook.Path 'loads the file location on the loc variable
MsgBox loc
' creates the file name for saving includes the current path.
NewFilename = loc + "\" + Range("NewFileName").Value & ".xlsm"
'tempmm = Application.GetSaveAsFilename initialfilename
ActiveWorkbook.SaveAs NewFilename, FileFormat:=52
'Application.DisplayAlert = False
'On Error Resume Next 'to omit error when cancel is pressed
' MsgBox "Not saved"
'ActiveWorkbook.Save
'If Err.Number <> 1004 Then 'optional, to confirmed that is not saved
' MsgBox "Not saved"
'End If
' On Error GoTo 0 'to return standard error operation
End Sub
Sub saving()
' Saves the file under a new name based on the new month date.
Dim NewFilename As String
Dim loc ' variable for file location
loc = Application.ThisWorkbook.Path 'loads the file location on the loc variable
' creates the file name for saving includes the current path.
NewFilename = loc + "\" + Range("NewFileName").Value & ".xlsm"
ActiveWorkbook.SaveAs NewFilename, FileFormat:=52
End Sub
I also added message boxes to try see what it is doing during testing. I have also tried the Getsaveasfilename in order to give the user an option to choose his/her own filename and possibly folder. The file location will change once a year.
If Your are looking at overwriting existing file, when there's already a file with same name try below.
NewFilename = loc + "\" + Range("NewFileName").Value & ".xlsm"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs NewFilename, FileFormat:=52
Application.DisplayAlerts = True
I am trying to loop through files in a folder on Mac OS X using VBA Excel 2011. I tried the following code, but it does not work.
Sub ListAllFilesInDir()
Dim strFile As String
Dim strPath1 As String
strPath1 = ActiveWorkbook.FullName
MsgBox strPath1
strFile = Dir(strPath1)
MsgBox strFile
strFile = Dir()
MsgBox strFile
strFile = Dir()
MsgBox strFile
End Sub
I get the name of the active workbook when the program reaches the first MsgBox strFile. I read somewhere that using Dir without an argument results in the next file in the folder. But that does not work for me. I get an empty message box for the second MsgBox strFile command and an error (Runtime error 5: Invalid Procedure call or argument" for the third MsgBox strFile command. I have 4 files in the folder that I am trying to loop through.
Also, what would I do to list only ".xslx" files
Here's a link to a description of the dir() function. Your issue is that dir(strPath1) will set the dir function to return all instances of that EXACT filename in that path, which is only ever going to be a single file. If you'd like all files ending in ".xlsx" try:
dir(ActiveWorkbook.Path & application.PathSeparator & "*.xlsx")
Also, if you have an arbitrary number of files you want to loop through try the following code. It works becuase dir returns an empty string after it's returned the last file:
Sub WorkWithFiles()
Const PATH = "C:\"
Dim file As String
file = Dir(PATH & Application.PathSeparator & "*.xlsx")
Do Until file = ""
'Run some code on the file in the file variable
Debug.Print file
'Then get the next file
file = Dir("")
Loop
End Sub