I am looking for a way to save my files and add a count after each file, so file 1, next file will have 2 at the end of it and 3 then 4, and so on
ActiveWorkbook.SaveAs "C:\Martin\1BankFiles\Recon" & " " & Format(Now(), "DD-MMM-YYYY") & ".XLSX", FileFormat:=51
what to add to the above VBA code to achieve so.
You need a way to figure out which was the last file written (and if it was written today or earlier).
As your macro stops, using a global variable is not reliable. I guess the easiest way would be to look into the folder where you write the files.
The following function will do exactly that: look for all files with the current date in the file name, figure out the highest number and return the next "free" filename.
Function GetNextFilename()
Const BasePath = "C:\Martin\1BankFiles\"
Dim BaseFilename As String
BaseFilename = "Recon " & Format(Now(), "DD-MMM-YYYY") & "_"
Dim filename As String, filenumber As Long, largestNumber As Long
filename = Dir(BasePath & BaseFilename & "*.xlsx")
Do While filename <> ""
filenumber = Val(Mid(filename, Len(BaseFilename) + 1))
If filenumber > largestNumber Then largestNumber = filenumber
filename = Dir
Loop
GetNextFilename= BasePath & BaseFilename & (largestNumber + 1) & ".xlsx"
End Function
Your Save-commmand would simply be
ActiveWorkbook.SaveAs GetNextFilename, FileFormat:=xlWorkbookDefault
Related
I am working in VBA. I want to save the excel document with values from my sheet. However, repeats of the same file name can exist. If the same file name is repeated, I would like the VBA to save it as a different version number. For example, if the file name is CAT DOG and there is a second file saved as CAT DOG, I want the VBA to automatically save it as V-2. And if there is already a V-2, to than save if as V-3 and so on. This is the code I have so far. It saves great normally but I am having trouble with getting the version numbers added. I have attached an image of the code so far
''''
path = ""
filename1 = ws.Range("D5").Text &
ws.Range("O3").Text`e`ws.Range("D6").Text
If filename1(path & filename1 & ".xlsm") = False Then
ActiveWorkbook.SaveAs Filename:=(path & filename1 & ".xlsm"),
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Exit Sub
End If
Do While Saved = False
If filename1(path & filename1 & x & ".xlsm") = False Then
ActiveWorkbook.SaveAs Filename:=(path & filename1 & x & ".xlsm"),
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Saved = True
Else
x = x + 1
End If
Loop
MsgBox "New file version saved (version " & x & ")"
Do Not Overwrite Saved Files (Versioning)
Adjust the values in the constants section.
Using the current setup, it will create files with the following names:
CAT DOG.xlsm
CAT DOG (V-2).xlsm
CAT DOG (V-3).xlsm
etc.
in the Test folder on drive C.
The Code
Option Explicit
Sub DoNotOverWrite()
Const dFolderPath As String = "C:\Test\"
Const dBaseName As String = "CAT DOG"
Const dLeft As String = " (V-"
Const dFirstNumber As Long = 2
Const dRight As String = ")"
Const dExtension As String = ".xlsm"
Dim dFilePath As String: dFilePath = dFolderPath & dBaseName & dExtension
Dim dFileName As String: dFileName = Dir(dFilePath)
Dim n As Long: n = dFirstNumber - 1
Do Until Len(dFileName) = 0
n = n + 1
dFilePath = dFolderPath & dBaseName & dLeft & n & dRight & dExtension
dFileName = Dir(dFilePath)
Loop
' If the workbook is the one containing this code, use 'ThisWorkbook'.
ActiveWorkbook.SaveAs dFilePath, xlOpenXMLWorkbookMacroEnabled
If n < dFirstNumber Then
MsgBox "File saved.", vbInformation
Else
MsgBox "New file version saved (version " & n & ")", vbInformation
End If
End Sub
I would like to list the files and subfolders to an Excel sheet with vba macro. The listing is working, but the last file of last folder moves to first place of actual folder in the list.
Here is the result:
And here is the code:
If selectedFolder.Files.Count = 0 Then
For Each origSubFolder In selectedFolder.SubFolders
'Create backup subfolder
copiedSubFolder = copiedFilesDir & "\" & origSubFolder.Name & affix
fso.CreateFolder copiedSubFolder
'Recording folders to Excel file
rfSht.Range("C" & r).Value = origSubFolder
rfSht.Range("M" & r).Value = copiedSubFolder
r = r + 1
For Each File In origSubFolder.Files
'Save As original files as xlsx
fileName = fso.GetFileName(File)
fileNameWOExt = Left(fileName, (InStrRev(fileName, ".", -1, vbTextCompare) - 1))
'fileNameWOExt = Left(fileName, InStr(fileName, ".") - 1)
fileNameWAffix = fileNameWOExt & affix
Set owb = Workbooks.Open(File)
owb.SaveAs fileName:=copiedSubFolder & "\" & fileNameWAffix, FileFormat:=51
ActiveWorkbook.Close
'Recording files to Excel file
rfSht.Range("D" & r).Value = File
rfSht.Range("N" & r).Value = copiedSubFolder & "\" & fileNameWAffix & ".xlsx"
r = r + 1
Next
Next
MsgBox "Task completed", vbInformation
Else
I was looking for the problem in the for each loop or "r=r+1", but always get this. Could you help me?
You could do 2 things 1 is sorting the output in an array on VBA and then print the Array. else you could also sort output on excel. I would recommend the first one.
I'm trying to get a macro to work as a version history tool. I think I'm using basic methods here and there might be better ones out there but I think it's doable nonetheless. The error I get is "Subscript out of range". The culpript is the second to last line of my code, which is where I save a copy of the file. So this is my code:
Sub Historian()
Dim filePath As String
Static counter As Integer
Dim fileName As String
filePath = "A:\Downloads A\Ex_Files_Learning_VBA_Excel\Exercise Files\Ch05\WbkBackup"
For counter = 0 To 10
Workbooks.Open (filePath & counter)
On Error GoTo Handler:
Next counter
MsgBox ("counter has reached 10")
Exit Sub
Handler:
ThisWorkbook.Activate
fileName = ThisWorkbook.FullName
Workbooks(fileName).SaveCopyAs fileName:=(filePath & counter)
MsgBox ("ok, last version was: " & counter)
End Sub
Workbooks(filename) do not take the filename full path as argument, only the filename.
Change Workbooks(filename) to ThisWorkbook as suggested by Warcupine
To improve your code, I would suggest you not to test the opening of Workbook. This is long and then you have to close the workbooks you opened...
Instead you could use the Dir() function:
Check if the file exists using VBA
On Error GoTo Handler
should be placed before
Workbooks.Open (filePath & counter)
which should be:
Workbooks.Open (filePath & "\" & split(Thisworkbook.Name, ".")(0) & counter & "." & split(Thisworkbook.Name, ".")(1))
In fact, your code should look in this way:
Sub Historian()
Dim filePath As String, fileName As String, strExt As String
Static counter As Long
filePath = "C:\Teste VBA Excel\PROG BACKUP" ' "A:\Downloads A\Ex_Files_Learning_VBA_Excel\Exercise Files\Ch05\WbkBackup"
fileName = Split(ThisWorkbook.Name, ".")(0)
strExt = Split(ThisWorkbook.Name, ".")(1)
For counter = 0 To 10
On Error GoTo Handler:
Workbooks.Open (filePath & "\" & fileName & counter & "." & strExt)
Next counter
MsgBox ("counter has reached 10")
Exit Sub
Handler:
ThisWorkbook.SaveCopyAs fileName:=(filePath & "\" & fileName & counter & "." & strExt)
MsgBox ("ok, last version was: " & counter)
End Sub
But I think that checking the existing of the workbook by opening it, is not so appropriate way. I would suggest you to replace
On Error GoTo Handler:
Workbooks.Open (filePath & "\" & fileName & counter & "." & strExt)
with
If Dir(filePath & "\" & fileName & counter & "." & strExt) = "" Then GoTo Handler
my folder contains many files. And I have similar folder for each months. Datafiles are having same name but they are on different folders. What I want is to copy a specific column (computed result) of previous month's datafile to new month's datafile.
My code is
Dim fileName1, Pathname1 As String
Pathname1 = "c:\Charts\1\"
For Each vFile1 In vArr1
fileName1 = Dir(Pathname1 & vFile1 & "\" & "*.xlsx")
Do While fileName1 <> ""
Set WB1 = Workbooks.Open(Pathname1 & vFile1 & "\" & fileName1)
WB1.Application.ScreenUpdating = False
WB1.ActiveSheet.Columns("M").Copy
WB1.Close (False)
For Each vFile In vArr
fileName = Dir(Pathname & vFile1 & "\" & "*.xlsx")
If fileName = fileName1 Then
Set WBD1 = Workbooks.Open(Pathname & vFile1 & "\" & fileName1)
WBD1.ActiveSheet.Columns("C").Select
WBD1.ActiveSheet.Paste
WBD1.Close (True)
Else
End If
Next
Loop
Next
What i am doing is
1. open a file
copy a column
checking the filenames are same
if they are same paste the copied data
BUt the loop gets infinite.
I debugged and couldn't find it
pls help
When you use the DIR function with an argument it finds the first file that matches the specified criteria. If you want to get the next file, use DIR() on its own.
In your code you are getting the first file over and over again and never reaching the condition where filename1 = ""
I am looking for VBA to add to my macro that will increment the file name if the file name already exists.
Current Code:
Dim filepath As String
Dim filename As String
Dim filepatharch As String
Dim filedate As String
Dim filelist As String
'Grab FROM list number
Sheets("TD File").Select
Range("G4").Select
filelist = ActiveCell.Value
'Grab today's date
filedate = Format(Now, "MMDD01.") --------------Currently where the '01' comes from (see below)
'Set where to save and the file naming convention
filepath = "\\home\serverfolder\FileDrop\"
tdfilename = "TD" & filedate & filelist
'& ".txt"
'Set where to save and the file naming convention
filepatharch = "\\home\myfolder\archive"
tdfilename = "TD" & filedate & filelist
'& ".txt"
'Save THXXXXXX.XXX & TDXXXXXX.XXX as flat files
'Workbooks("MYWORK01").Activate
Sheets("TDflatfile").Copy
ActiveWorkbook.SaveAs filename:= _
"\\home\serverfolder\FileDrop\" & tdfilename, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWindow.Close
An example of the saved file name would be "TD101401.600". TD + MMDD + 01 + .XXX. I would like the "+ 01 " to be the number that increments, that way I could have a file that is "TD101402.600" and so forth. Currently if the file exists for the same .XXX number and date combo, it gets overwritten. The .XXX cannot be the increment.
Is this possible?
Someone suggested this and it worked for me:
Dim filecount As Integer
Do While Len(Dir(filepatharch & thfilename)) <> 0
filecount = filecount + 1
filedate = Format(Now, "MMDD0" & filecount & ".")
tdfilename = "TD" & filedate & filelist
thfilename = "TH" & filedate & filelist
Loop
Just put a conditional loop with Dir()
Do While ((Dir(filepath & tdfilename)) <> Empty)
inc = inc+1
filedate = Format(Now, "MMDD") & "." & Format(inc, "00")
tdfilename = "TD" & filedate & filelist
Loop