I need to make a loop that will save the edited files in a folder in numerical order, but if I run the macro again it needs to keep from the last number:
wb.SaveAs "C:\User\Desktop\Data\" & i & ".dat"
i = i + 1
Here the code saves the files in order (1,2,3). And if I run the macro again it needs to save (4,5,6).
I tried to use this loop above to save the function:
Do While Dir("C:\User\Desktop\Data\" & i & ".dat") = i
i = i + 1
Loop
But apparently, I can't use the DIR function, because I'm already using it at the end of the loop to get the next file, and the loop breaks.
'Get next file name
MyFile = Dir
So, is there's any way to do this? I'm trying to make a function that would check and return true or false to whether a file with that number already exists, but could not make it work. Thanks for the help.
You could get the largest number in the directory, and keep going from there?
This code presumes that all the files are named as such: [numericalfilename].[extension] for example "143.dat". This code will not work if there are alpha characters in the file-name (apart from extension)
Once you have defined Path and Extension variables, you can call the Function NextNumber which will give you [MaxNumber_In_Directory] + 1
From here you can perform your "save loop", by setting i = NextNumber(Path, "*." & Ext)
Sub test()
Dim Path As String
Dim Ext As String
Dim i as Long
' ***** REPLACE VARIABLES ******
Path = "C:\New\New Folder"
Ext = "dat"
' ******************************
i = NextNumber("C:\New\New Folder", "*." & Ext)
' ********************************
' **** PERFORM SAVE CODE HERE ****
' ********************************
'I am not 100% sure of your save loop, you'll need to modify this
wb.SaveAs "C:\User\Desktop\Data\" & i & ".dat"
i = i + 1
End Sub
Public Function NextNumber(strPath As String, strExt As String) As Long
Dim vArray(500)
Dim i As Long
Dim length As Long
ChDir strPath
strExtension = Dir(strExt)
'Perform Loop
Do While strExtension <> ""
length = Len(strExtension) - (Len(strExt) - 2) - 1
vArray(i) = CLng(Mid(strExtension, 1, length))
i = i + 1
strExtension = Dir
Loop
NextNumber = WorksheetFunction.Max(vArray) + 1
End Function
Related
I need to open a file whose full filename I do not know.
I know the file name is something like.
filename*esy
I know definitely that there's only one occurrence of this file in the given directory.
filename*esy is already a "shell ready" wildcard & if thats alway the case you can simply;
const SOME_PATH as string = "c:\rootdir\"
...
Dim file As String
file = Dir$(SOME_PATH & "filename*esy" & ".*")
If (Len(file) > 0) Then
MsgBox "found " & file
End If
Just call (or loop until empty) file = Dir$() to get the next match.
There is an Application.FileSearch you can use (see below). You could use that to search for the files that match your pattern. This information taken from here.
Sub App_FileSearch_Example()
With Application.FileSearch
.NewSearch
.LookIn = "c:\some_folder\"
.FileName = "filename*esy"
If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
For i1 = 1 To .FoundFiles.Count
' do something with matched file(s)
Next i1
End If
End With
End Sub
If InStr(sFilename, "filename") > 0 and InStr(sFilename, "esy") > 0 Then
'do somthing
end if
Or you can use RegEx
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "filename(.*)esy"
End With
Set REMatches = RE.Execute(sFilename)
REMatches(0) 'find match
I was trying this question as a function. This is the solution that ended up working for me.
Function fileName(path As String, sName As String, ext As String) As Variant
'path is Full path from root. Can also use path = ActiveWorkbook.path & "\"
'sName is the string to search. ? and * are wildcards. ? is for single char
'example sName = "book?" or sName ="March_*_2014*"
'ext is file extention ie .pdf .xlsm .xls? .j*
Dim file As Variant 'Store the next result of Dir
Dim fname() As String 'Dynamic Array for result set
ReDim fname(0 To 0)
Dim i As Integer ' Counter
i = 0
' Use dir to search and store first result
fname(i) = path & Dir(path & "\" & sName & ext)
i = i + 1
'Load next result
file = Dir
While file <> "" 'While a file is found store that file in the array
ReDim Preserve fname(0 To i) As String
fname(i) = path & file
file = Dir
Wend
fileName = Application.Transpose(fname) 'Print out array
End Function
This works for me as a single or array function.
If you know that no other file contains "filename" and "esy" in that order then you can simply use
Workbooks.Open Filename:= "Filepath\filename*esy.*"
Or if you know the number of missing characters then (assuming 4 characters unknown)
Workbooks.Open Filename:= "Filepath\filename????esy.*"
I use this method to run code on files which are date & timestamped to ignore the timestamp part.
I've found this code that renames all the files into a specific folder.
Const FolderLoc = "C:\Users\chf000\Desktop\AAA\"
Dim x As Long
x = 1
Dim s As String
s = Dir(FolderLoc & "*.*")
Do While s <> ""
Name FolderLoc & s As FolderLoc & "ANIMATIC-" & x & ".png"
s = Dir()
x = x + 1
Loop
It works, but I've got an issue during the renaming. Basically, I've got a png's sequence into the folder, like this: SHOT001_00.png and SHOT001_01.png and so one.
the sequence has more than 100 frames.
the script changes the name from SHOT001_00.png to ANIMATIC-0.png and so one.
When I run the script, the files are renamed in the wrong order.
For example, the file named ANIMATIC-12.png contains the image that belongs to frame 101.
I guess is a problem of how the script sort the files in the folder, is sorting in a sort of alphabetical order, rather than numerical order.
Does anyone know how can I edit the script in order to rename and keep the correct order?
Thanks
I think you should first put all the names in an array and then rename them from that list.
I use this code to get the file list into an array:
Private Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
'Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
I have an issue and I need your help. here is the problem. I have inside a folder some excel files that I have to open automatically in order to make some operations. Those files have the same name except the number of the files like this:
Folder name : Extraction_Files
Files name : - "System_Extraction_Supplier_1"
- "System_Extraction_Supplier_2"
- "System_Extraction_Supplier_3"
The number of files can change so i used a loop Do While to count the number of files, then the plan is to use a loop for I =1 to ( number of files) to open all of theme.
please read my code. I know that i used a wrong way to read file name using a loop for but I share it because I don't have an other idea.
Here is my code :
Sub OpenFiles ()
Dim MainPath as String
Dim CommonPath as String
Dim Count As Integer
Dim i As Integer
' the main path is " C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
'with i = 1 to Count ( file number )
CommonPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_*"
'counting automatically the file number
Filename = Dir ( CommonPath )
Do While Filename <> ""
Count = Count + 1
Filename = Dir ()
Loop
'the issue is below because this code generate a MsgBox showing a MainPath with the index i like this
'"C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
' so vba can not find the files
For i = 1 To count
MainPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_" & "i"
MsgBox MainPath &
Workbooks.Open MainPath
Next
End Sub
what is the best approach to this?
Why not count as you open them. You're already identifying them so why not open each file as you go:
Sub OpenFiles()
Dim Filename As String
Dim CommonPath As String
Dim Count As Integer
CommonPath = "C:\Desktop\Extraction_Files\"
Filename = Dir(CommonPath & "System_Extraction_Supplier_*")
Do While Filename <> ""
MsgBox Filename
Workbooks.Open CommonPath & Filename
Count = Count + 1
Filename = Dir()
Loop
End Sub
PS. It might be worth adding .xl* or similar to the end of your search pattern to prevent Excel trying to open files that aren't Excel files:
Filename = Dir(CommonPath & "System_Extraction_Supplier_*.xl*")
If you want to open all folders, in a specific folder, which start with "NewFile_", one loop only is needed:
Sub OpenFolders()
Dim path As String: path = ""C:\Desktop\Extraction_Files\""
Dim fileStart As String: fileStart = "System_Extraction_Supplier_"
Dim Fso As Object
Dim objFolder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = Fso.GetFolder(path)
For Each objSubFolder In objFolder.subfolders
If InStr(1, objSubFolder.Name, fileStart) Then
Shell "explorer.exe " & objSubFolder, vbNormalFocus
Debug.Print objSubFolder.Name
End If
Next objSubFolder
End Sub
Folders in vba are opened with the Shell "explorer.exe " command. The code opens every folder in "C:\yourFile\", which contains NewFile_ in the name. This check is done with If InStr(1, objSubFolder.Name, fileStart) Then.
(Excel 2010)
I'm trying to grab specific lines from a variety of "target" workbooks in different but similar folders. I have found that I am able to pull this data when the source ("LM", the workbook the code is executing in, and that I want to pull the data to) and target workbooks are in the same folder without opening the target's workbook, but when they are in different locations (as they will be in practice) I receive a "Subscript out of range" error for the
LM.Worksheets("Sheet1").Range("B" & i + 1 & ":G" & i + 1).Value = _
Workbooks(filename).Worksheets("Sheet1").Range("B6:G6").Value
line. I have tried:
Using every variant & combination on pathname, dirname & filename, etc. as the argument for the latter Workbooks(). I have also had it MsgBox me the pieces and whole of pathname and filename to look at, which are error-free.
Replacing the latter Workbooks(filename) with a workbook variable (lets call it Targ), like LM (which works fine)
Changing the path with ChDir and ChDrive (& I have confirmed that the CurDir() is in fact the target directory when this is running) and doing the above
Using ThisWorkbook instead of LM for the call
Basically every permutation of the above ideas
Here is a stripped-down (because confidential stuff was in there) version of the code (which works fine if I un-comment Workbooks.Open and Workbooks.Close, but I want a more efficient method since this is a busy network and people are in-and-out of these files all the time. The fact that I can do this without opening the files if they're in the same folder tells me I'm onto something...)
Sub Import()
Dim directory As String, fileName As String, LM As Workbook, i as Integer
Set LM = Workbooks("LM.xlsm")
i = 1
Dim DirArray As Variant
'this is the array that handles the variations on the path, doesn't seem to be the problem
DirArray = LM.Worksheets("Sheet2").Range("DirTable")
Do While i <= UBound(DirArray)
directory = DirArray(i, 1)
dirname = "C:\blahblahblah"
fileName = Dir(dirname & "*.xl??")
pathname = dirname & fileName
ChDir dirname
' Workbooks.Open (dirname & fileName)
LM.Worksheets("Sheet1").Range("B" & i + 1 & ":G" & i + 1).Value = _
Workbooks(filename).Worksheets("Sheet1").Range("B6:G6").Value
i = i + 1
' Workbooks(fileName).Close
Loop
End Sub
If I could just figure out what is different when they're in the same folder! Navigating with ChDir and ChDrive doesn't seem to do any good...
It's unclear exactly what you want to do, but this should be a working version of your posted code.
Is there only one Excel file per folder? Did you want to use directory in place of the hard-coded DIRNAME ?
Sub Import()
Const DIRNAME As String = "C:\blahblahblah\"
Dim directory As String, fileName As String, LM As Workbook, i As Integer
Dim DirArray As Variant, wb As Workbook
Set LM = Workbooks("LM.xlsm") 'ThisWorkbook ?
DirArray = LM.Worksheets("Sheet2").Range("DirTable").Value
For i = 1 To UBound(DirArray, 1)
directory = DirArray(i, 1) 'what are these values ?
fileName = Dir(DIRNAME & "*.xl??")
If fileName <> "" Then
'ChDir dirname '<< you do not need this if you pass the full path to Open...
Set wb = Workbooks.Open(filename:=DIRNAME & fileName, _
ReadOnly:=True, UpdateLinks:=0)
LM.Worksheets("Sheet1").Range("B" & (i + 1) & ":G" & (i + 1)).Value = _
wb.Worksheets("Sheet1").Range("B6:G6").Value
wb.Close False 'no save
End If
Next
End Sub
I am currently trying to create a spreadsheet which keeps track of how many files have been quality checked against those that haven't and then displays the amount left to be checked as a percentage.
Currently on open the spreadsheet pulls the details from a checked folder and a work to be checked folder as follows:-
Private Sub pdf_loading()
Range("M5").Clear
Dim FolderPath As String, path As String, count As Integer
FolderPath = "C:\path to folder\"
' looks in spercific folder
path = FolderPath & "*.pdf"
' for file type this time it is pdf files, though if you change this is could be word files, or psd's
Filename = Dir(path)
Do While Filename <> ""
' checks for filename <less than or >greater than "filename" as "" is empty does not look for spercific file
count = count + 1
' counts amount of pdf files, add 1 to the last known number
Filename = Dir()
' contiunes count until it reaches the end of the directory
Loop
Range("M5").Value = count
' puts final count value in cell
For Each Cell In [M:M]
If Cell.Value = "0" Then
Cell.ClearContents
ElseIf Range("M5").Value >= 1 Then
End If
Next Cell
End Sub
Then for the checked folder:-
Private Sub checked_loading()
Range("M6").Clear
Dim FolderPath As String, path As String, count As Integer
FolderPath = "C:\path to folder\"
path = FolderPath & "*.pdf"
Filename = Dir(path)
Do While Filename <> ""
count = count + 1
Filename = Dir()
Loop
Range("M6").Value = count
For Each Cell In [M:M]
If Cell.Value = "0" Then
Cell.ClearContents
ElseIf Range("M5").Value >= 1 Then
End If
Next Cell
End Sub
This works fine, though currently the formula I have tried to generate the percentage is as follows:-
=IF(M5=M6,"50%",IF(M5=0,"100%",IF(M6=0,"0%",SUM(M5*M6/100*1))))
This brings back incorrect results like 144.00% when the files to be check result is 9 and the files checked result is 16.
I would prefer to have the percentage calculation to be in vba so that end users could not accidentally delete the underlying formula.
Any help on this issue or if there is a more efficient code structure would be most appreciate.
Not to worry I have found a solution which works a treat. The above code now looks like this for the work to be checked:-
Private Sub pdf_loading()
Range("K5:L6").ClearContents
Range("M5").ClearContents
' Clear cell contents on open
Dim FolderPath As String, path As String, count As Integer
FolderPath = "C:\filepath\folder\"
' looks in spercific folder
path = FolderPath & "*.pdf"
' for file type this time it is pdf files, though if you change this is could be word files, or psd's
Filename = Dir(path)
Do While Filename <> ""
' checks for filename <less than or >greater than "filename" as "" is empty does not look for spercific file
count = count + 1
' counts amount of pdf files, add 1 to the last known number
Filename = Dir()
' contiunes count until it reaches the end of the directory
Loop
Range("M5").Value = count
' puts final count value in cell
End Sub
and the work checked folder is now like this:-
Private Sub checked_loading()
Range("M6").ClearContents
Dim FolderPath As String, path As String, count As Integer
FolderPath = "C:\filepath\folder\"
path = FolderPath & "*.pdf"
Filename = Dir(path)
Do While Filename <> ""
count = count + 1
Filename = Dir()
Loop
Range("M6").Value = count
Range("N5").Formula = "=Sum(M5,M6)"
Range("K5").Formula = "=SUM(M6/N5*1)"
' adds formulas to selected cells to give percentage
End Sub