I am trying to write a code that opens the most recent file in a folder and copy data from it. I am having trouble setting it as a source for the copying without the specific file name. I do not want to set a file name as I just want it to take the most recent file and copy it.
I was able to get it to open the most recent file, but it is getting stuck on source data. My goal is to not have to manually select a file every time a newer one comes out.
Sub CopyDataFromCSVFiles()
Dim SourceFolder As String
Dim MasterWorkbook As Workbook
Dim CurrentData As Workbook
Dim DataSheet As Worksheet
Dim MasterSheet As Worksheet
Dim CSVFile As String
Dim NextRow As Long
Dim FileExtension As String
' Set the source folder containing CSV files
SourceFolder = "P:\Fluid Products Engineering\EOP Tester Data\Combination Program\Raw Data\"
' Set the master workbook (file picker dialog)
Set MasterWorkbook = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm), *.xls; *.xlsx; *.xlsm", Title:="Please select the master workbook")
If MasterWorkbook = "False" Then
MsgBox "No master workbook selected. Exiting..."
Exit Sub
Else
Set MasterWorkbook = Workbooks.Open(MasterWorkbook)
End If
' Set master worksheet
Set MasterSheet = MasterWorkbook.Sheets(1)
' Loop through each file in the folder
CSVFile = Dir(SourceFolder & "*.csv")
Do While CSVFile <> ""
' Open current CSV file
Set CurrentData = Workbooks.Open(SourceFolder & CSVFile)
' Set current data worksheet
Set DataSheet = CurrentData.Sheets(1)
' Determine the next available row in master workbook
NextRow = MasterSheet.Cells(MasterSheet.Rows.Count, "A").End(xlUp).Row + 1
' Copy data from current CSV file to master workbook
DataSheet.UsedRange.Copy MasterSheet.Cells(NextRow, 1)
' Close current CSV file without saving changes
CurrentData.Close False
' Get next CSV file
CSVFile = Dir
Loop
' Close master workbook with saving changes
MasterWorkbook.Close True
MsgBox "Data has been successfully copied to the master workbook.", vbInformation
End Sub
PERSONAL.xlsb
!?)Sub CopyRawData()
Const SRC_FOLDER_PATH As String = "U:\Documents\Macro Testing\Raw Data\"
Const SRC_FILE_PATTERN As String = "SLTEST_*.csv"
Const SRC_FIRST_ROW_RANGE As String = "A2:G2"
Const DST_FILE_PATH As String _
= "U:\Documents\Macro Testing\Data\Finished Data.xlsx"
Const DST_SHEET_NAME As String = "Banana"
Const DST_FIRST_CELL As String = "A2"
Dim sFileName As String: sFileName = Dir(SRC_FOLDER_PATH & SRC_FILE_PATTERN)
If Len(sFileName) = 0 Then
MsgBox "No file matching the pattern """ & SRC_FILE_PATTERN _
& """ found in """ & SRC_FOLDER_PATH & """!", vbExclamation
Exit Sub
End If
Dim sFilePath As String, sFilePathFound As String
Dim sFileDate As Date, sFileDateFound As Date
Do While Len(sFileName) > 0
sFilePathFound = SRC_FOLDER_PATH & sFileName
sFileDateFound = FileDateTime(sFilePathFound)
If sFileDate < sFileDateFound Then
sFileDate = sFileDateFound
sFilePath = sFilePathFound
End If
sFileName = Dir
Loop
Application.ScreenUpdating = False
Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath, , True) ' , Local:=True)
Dim sws As Worksheet: Set sws = swb.Sheets(1)
Dim srg As Range, slcell As Range, rCount As Long
With sws.Range(SRC_FIRST_ROW_RANGE)
Set slcell = .Resize(sws.Rows.Count - .Row + 1) _
.Find("*", , xlValues, , xlByRows, xlPrevious)
If slcell Is Nothing Then
swb.Close SaveChanges:=False
MsgBox "No data found in workbook """ & sFilePath & """!", _
vbExclamation
Exit Sub
End If
rCount = slcell.Row - .Row + 1
Set srg = .Resize(rCount)
End With
Dim dwb As Workbook: Set dwb = Workbooks.Open(DST_FILE_PATH)
Dim dws As Worksheet: Set dws = dwb.Sheets(DST_SHEET_NAME)
Dim drg As Range: Set drg = dws.Range(DST_FIRST_CELL) _
.Resize(rCount, srg.Columns.Count)
srg.Copy Destination:=drg
swb.Close SaveChanges:=False
With drg
' Clear below.
.Resize(dws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
' Format.
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
'.EntireColumn.AutoFit
End With
'dwb.Close SaveChanges:=True
Application.ScreenUpdating = True
MsgBox "Raw data copied.", vbInformation
End Sub