VBA loop through directory - vba

**Hi All,
I would to incorporate into the below script the ability to search through files and export ONLY the data from the most recent file in folder. I will be adding a new file every week into folder so do not want the old data range to be copied across.
Can someone please help?**
Sub loopthroughdirectory()
Dim myfile As String
Dim erow
fileroot = "C:\Users\ramandeepm\Desktop\consolidate\"
myfilename = Dir("C:\Users\ramandeepm\Desktop\consolidate\")
Do While Len(myfilename) > 7
If myfilename = "zmaster.xlsm" Then
Exit Sub
End If
myfile = fileroot & myfilename
Workbooks.Open (myfile)
Range("range").Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 4))
myfilename = Dir()
Loop
End Sub

If you use FileSystemObject it can be done using the .DateLastModified property. The below code should get you started:
Untested
Dim FSO As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dtFile As Date
'set folder location
Const myDir As String = "C:\Users\ramandeepm\Desktop\consolidate"
'set up filesys objects
Set FSO = New FileSystemObject
Set myFolder = FSO.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dtFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If Len(objFile.Name) > 7 Then
If objFile.DateLastModified > dtFile Then
dtFile = objFile.DateLastModified
strFilename = objFile.Name
End If
End If
Next objFile
Workbooks.Open strFilename
Note: This code is looking for the most recent modified date. So this will only work if the newest file was created after any modifications in other files in the folder. Also, you may need to enable the Microsoft Scripting Runtime library reference.

Related

Loop find last modified file with a specific name inside a folder

Here is my problem, on my excel sheet I put paths of every folder that I want to check
V:\Folder1\
V:\Folder2\
Inside those folder I want vba to give me the name of the last modified file based on a specific name.
I will give an example:
In my folder1 I have those files :
Lo_2021_1
Lo_Full_2021_1
Lo_2021_2
Lo_Full_2021_2
...
Lo_2021_50
Lo_Full_2021_50
In my folder2 I have those files :
Li_2021_1
Li_Full_2021_1
Li_2021_2
Li_Full_2021_2
...
Li_2021_50
Li_Full_2021_50
I want vba to give me the name of the last modified file that starts with Lo_2021 in my folder1 and Li_2021 in my folder2 (so I don't want Lo_Full and Li_Full)
I already created a code that gave me the name of the last modified files but they are Lo_Full_2021_50 and Li_Full_2021_50 whereas I want Lo_2021_50 and Li_2021_50
Here is my code :
Option Explicit
Sub name_last_file()
Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dteFile As Date
Dim list_path As Range
Dim path_ As Range
Dim myDir As String
Set list_path = Range("B2", Range("B2").End(xlDown))
For Each path_ In list_path
myDir = path_.Value
'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
Next objFile
MsgBox strFilename
Next path_
End Sub
This will give me Lo_Full_2021_50 and Li_Full_2021_50 whereas I want Lo_2021_50 and Li_2021_50.
Is there a way to say that I want the last modified file that start with Lo_2021 or Li_2020 so that I will get Lo_2021_50 and Li_2021_50 as a result ?
I'm really thankful for your help
Please, test the next updated code:
Sub Give_name_files()
Dim FileSys As FileSystemObject, objFile As File, myFolder As oobject
Dim strFilename As String, dteFile As Date, list_path As Range, path_ As Range
Dim strRoot As String
strRoot = "Lo_2021" 'the beginning of the tested files name
'First I Select paths that are on my excel cells
Set list_path = Range("B2", Range("B2").End(xlDown))
For Each path_ In list_path
myDir = path_.Value
'Set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If left(objFile.Name, Len(strRoot)) = strRoot Then
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
End If
Next objFile
MsgBox strFilename
Next path_
End Sub

Excel VBA - Loop VBAs with Data from Subfolder

I have a main Excel file and CSV data in several subfolders. I want now to load the CSVs from one subfolder, start another VBA-Script and then go to the next subfolder.
Example:
MyExcelFile.xlsm
Country 1
../Data1.csv
../Data2.csv
Country 2
../Data3.csv
../Data4.csv
Country1 Report1.csv Report2.csv Country2
Report3.csv Report4.csv
Load all CSVs from Country1, generate a Report, then go to Country2 and generate the report with this data.
Here is my VBA to load the CSVs (thanks to the Author mentioned):
Sub ImportCSVs()
'Author: Jerry Beaucaire
'Date: 8/16/2010
'Summary: Import all CSV files from a folder into separate sheets
Dim fPath As String
Dim fCSV As String
Dim wbCSV As Workbook
Dim wbMST As Workbook
Set wbMST = ThisWorkbook
fPath = (Application.ActiveWorkbook.Path & "\") 'path to CSV files, include the final \
Application.ScreenUpdating = False 'speed up macro
Application.DisplayAlerts = False 'no error messages, take default answers
fCSV = Dir(fPath & "*.txt") 'start the CSV file listing
On Error Resume Next
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV, xlDelimited, Delimiter:=",", Format:=6, Local:=False) 'open a CSV file
wbMST.Sheets(ActiveSheet.Name).Delete 'delete sheet if it exists
ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) 'move new sheet into Mstr
Columns.AutoFit 'clean up display
fCSV = Dir 'ready next CSV
Loop
Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub
Can anyone explain me, how I can go to all Subfolders and hand over the "Subfolder-Name" the the ImportCSVs-CSV? I was looking for this the whole afternoon, but couldn't find an answer.
Thank you so much in advance :-)
Thank you so much for your help. I managed to do exactly what i wanted with the following code:
Sub RunAll()
Dim Fso As Object, objFolder As Object, objSubFolder As Object, tempFolder
As Object
Dim FromPath As String
Dim fpath As String
Dim FileInFolder As Object
Dim ToPath As String
Dim temporaryFolder As String
temporaryFolder = "Temp"
fpath = (Application.ActiveWorkbook.Path & "\")
FromPath = fpath
ToPath = fpath & temporaryFolder & "\"
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)
'clean Masterfolder first
Set tempFolder = Fso.GetFolder(ToPath)
'loop through each subfolders
For Each objSubFolder In objFolder.subfolders
For Each File In tempFolder.Files
File.Delete
Next File
For Each FileInFolder In objSubFolder.Files
If FileInFolder.Name Like "*REPORT*.txt" Then 'criteria
FileInFolder.Copy ToPath
End If
Next FileInFolder
'Check if folder is empty
If Dir(ToPath & "*.*") = "" Then
Else
Call ImportCSVs
Call ImportData
Call PrintPDF
End If
Next objSubFolder
Call CloseFile
End Sub
Creating objects is the concept here. My way is loop through all CSV files in the target folder(includes its subfolders) , and then import those CSV meet my criteria into a new temp folder.
Then you can use your current code to load all CSV to mastersheet, rename and control the temp folder whatever. Hope this helps.
Dim Fso As Object, objFolder As Object, objSubFolder As Object, tempFolder As Object
Dim FromPath As String
Dim FileInFolder As Object
Dim ToPath As String
ToPath = "V:\MasterFolder\"
FromPath = "V:\TargetFolder\"
Set Fso = CreateObject("Scripting.filesystemobject")
'clean Masterfolder first
Set tempFolder = Fso.GetFolder(ToPath)
For Each File In tempFolder.Files
File.Delete
Next File
'loop through each subfolders
For Each objSubFolder In objFolder.subfolders
For Each FileInFolder In objSubFolder.Files
If FileInFolder.Name Like "*DATA*" Then 'criteria
FileInFolder.Copy ToPath
End If
Next FileInFolder
Next objSubFolder

Opening the youngest file in a folder VBA

Hi I am trying to open the latest file (date modified) in a folder. The code uses a loop to go through the files and find the latest modified which it does however when it comes to open the file using 'Workbooks.Open strFilename' it says the file (which it has already identified as the 'youngest' file could not be found. This doesn't make sense to me as the error message says the file 'test young' - the file name could not be found, but it clearly found it during the loop.
Sub copynewdata()
Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dteFile As Date
Dim Ref As Object, CheckRefEnabled%
CheckRefEnabled = 0
With ThisWorkbook
For Each Ref In .VBProject.References
If Ref.Name = "Scripting" Then
CheckRefEnabled = 1
Exit For
End If
Next Ref
If CheckRefEnabled = 0 Then
.VBProject.References.AddFromGUID "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0
End If
End With
'set path for files - change for your folder
Const myDir As String = "\\C:\Test"
'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
Next objFile
Workbooks.Open strFilename
'Set Source_Workbook = Workbooks(strFilename).Open(Target_Path)
Set FileSys = Nothing
Set myFolder = Nothing
End Sub
Can anyone help with this?
In strFilename, you have the name of the file - but without the path. Change the open-command to
Workbooks.Open myDir & "\" & strFilename

Excel VBA - movefile syntax

Please help with the code for copying files one by one to the destination folder. I tried with "for Each loop but it is copying all the files at once to the destination folder. I am new to to vba and would be helpful if someone could crack the code for me. thanks in advance. here's the code i have managed to come up with.
I am getting run time error 53, File not found,e highlighting the below syntax.
FSO.movefile Source:="C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro\" & Fname, Destination:="C:\Users\wazeer.ahamed\Documents\TcktIDfolder\" & Fname
Sub Example1()
'Extracting file names Dim objFSO As Object Dim objFolder As Object Dim newobjFile As Object
Dim lastID As Long Dim myRRange As Range Dim Maxvalue As Integer
Dim sFolder As String Dim dFolder As String
Sub Example1()
'Extracting file names
Dim FSO
Dim objFolder As Object
Dim newobjFile As Object
Dim FromDir As String
Dim ToDir As String
Dim lastID As Long
Dim myRRange As Range
Dim Maxvalue As Integer
Dim Fname As String
FromDir = "C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro\"
ToDir = "C:\Users\wazeer.ahamed\Documents\TcktIDfolder\"
Fname = Dir(FromDir)
If Len(FromDir) = 0 Then
MsgBox "No files"
Exit Sub
End If
Set myRange = Worksheets("Sheet1").Range("C:C")
Maxvalue = Application.WorksheetFunction.Max(myRange)
lastID = Maxvalue
'finding the next availabe row
erow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'Extracting file names
'Create an instance of the FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = FSO.GetFolder("C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro")
'loops through each file in the directory and prints their names and path
For Each newobjFile In objFolder.Files
'print file name
Cells(erow, 1) = Fname
'print file path
Cells(erow, 2) = newobjFile.Path
'PrintUniqueID
Cells(erow, 3) = lastID + 1
FSO.movefile Source:="C:\Users\wazeer.ahamed\Documents\Outlookemails_Macro\" & Fname, Destination:="C:\Users\wazeer.ahamed\Documents\TcktIDfolder\" & Fname
Cells(erow, 5) = "file succesfully copied"
Next newobjFile
Set FSO = Nothing
Set newobjFile = Nothing
Set objFolder = Nothing
End Sub
I think that the code can be more simple and dynamic if you play with your own excel file.
Use "A1" range to put the source folder.
Use "B:B" range to put the
name of the files.
Use "C:C" range to concatenate the previous
columns.
Use "D1" range to put the destination folder.
Sub copyFiles()
'Macro for copy files
'Set variable
Dim source As String
Dim destination As String
Dim x As Integer
Dim destinationNumber As Integer
destinationNumber = WorksheetFunction.CountA(ThisWorkbook.Sheets("Sheet1").Range("C:C"))
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Create the folder if not exist
If Dir(ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Sheet1").Range("D1"), 16) = "" Then
MkDir ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Sheet1").Range("D1")
End If
'Run the loop to copy all the files
For x = 1 To destinationNumber
source = ThisWorkbook.Sheets("Sheet1").Range("C" & x)
destination = ThisWorkbook.Sheets("Sheet1").Range("D1")
FileCopy source, destination
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
With this you can change the folders' paths and file names whenever you want. I've used FileCopy to preserve your files in the source but if you need to delete it's better use other method.

VBA - Open files in folder and print names

I want to open all of the files in a certain folder and have it print out the names of those files.
I have set up a code that opens the files but I cannot get it to print the name. I have a separate code that will print the name but will only open one file. I'm failing at combining the two together correctly. Any ideas?
Code that opens all Excel files:
‘set path to progress folder
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = “C:\Users\trembos\Documents\TDS\progress"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open fileName:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
Code that prints one file name:
'set path to TDS_Working
Sub TDS()
Workbooks.Open ("C:\Users\trembos\Documents\TDS\progress")
End Sub
'set up dim
Sub LoopThroughDirectory()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\trembos\Documents\TDS\progress\")
i = 1
'loop through directory file and print names
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.Name
Next objFile
End Sub
This should work smoothly :
Sub LoopThroughDirectory()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim MyFolder As String
Dim Sht As Worksheet
Dim i As Integer
MyFolder = "C:\Users\trembos\Documents\TDS\progress\"
Set Sht = ActiveSheet
'create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'get the folder object
Set objFolder = objFSO.GetFolder(MyFolder)
i = 1
'loop through directory file and print names
For Each objFile In objFolder.Files
If LCase(Right(objFile.Name, 3)) <> "xls" And LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
Else
'print file name
Sht.Cells(i + 1, 1) = objFile.Name
i = i + 1
Workbooks.Open Filename:=MyFolder & objFile.Name
End If
Next objFile
End Sub
You just need to iterate i inside the loop: i=i+1.
‘set path to progress folder
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
ActiveSheet.Unprotect ("password")
MyFolder = “C:\Users\trembos\Documents\TDS\progress"
MyFile = Dir(MyFolder & "\*.xlsx")
i=1
Do While MyFile <> ""
Workbooks.Open fileName:=MyFolder & "\" & MyFile
MyFile = Dir
Cells(i + 1, 1) =Myfile
i=i+1
Loop
ActiveSheet.Protect ("password")
End Sub
Does this not work?