Is there a way to set an open workbook as a source without having the file name?

83 Views Asked by At

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

2

There are 2 best solutions below

4
VBasic2008 On BEST ANSWER

Copy From One Closed Workbook to Another (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
0
CDP1802 On

You can use the dos DIR command to list the files in reverse date order and take the first one.

Option Explicit

Sub OpenNewest()

    Const sPath = "U:\Documents\Macro Testing\Raw Data\"
    Const sWild = "SLTEST_*.CSV"

    Dim wsh As Object, wb As Workbook, sFile As String
    Set wsh = CreateObject("WScript.Shell")
    
    sFile = wsh.Exec("cmd /c dir /B /O-d " & sPath & sWild).StdOut.ReadLine

    Set wb = Workbooks.Open(sPath & sFile)

End Sub