Copying data from files in a folder based on date using VBA

[trak]

Hi Everyone,

I am struggling with finding a solution to this problem I am having. What I have is a folder with a large number of files inside and a new file is added every 5 minutes. I want to grab all the files that fall in a specific weekly time period and copy all the contents into a new worksheet. For example, I want to pull files from last week so I would need to be able to pull all the files that fall under 1/22-1/28. Ideally, I would be able to change the dates for whatever week I need. The file names have the date and time included like this-"20230202085508" so I was thinking of running through the file names and choosing all the files that include the yyyy-mm-dd that I need but I am not sure if that is the way to go due to the amount of files in the folder. Thank you for anyone who would be able to help with this. This is my first time posting on here so please let me know if there is any information needed that I may have left out. Thanks everyone!

 

[John_w]

Try something like this macro start with, though we need more specific details to give a solution which works exactly as you require.

Public Sub Import_Workbooks_for_Week()

    Dim folder As String
    Dim file As String
    Dim weekBeginningDate As Date
    Dim fileDate As Date
    Dim destCell As Range
    Dim wb As Workbook
   
    folder = "C:\path\to\folder\"    'CHANGE THIS
    weekBeginningDate = DateSerial(2023, 1, 22)   'CHANGE THIS
   
    With ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
        Set destCell = .Range("A1")
    End With
   
    If Right(folder, 1) <> "\" Then folder = folder & "\"
       
    file = Dir(folder & "*.xlsx")
    While file <> vbNullString
        fileDate = DateSerial(Mid(file, 1, 4), Mid(file, 5, 2), Mid(file, 8, 2))
        If fileDate >= weekBeginningDate And fileDate <= weekBeginningDate + 6 Then
            Set wb = Workbooks.Open(folder & file)
            With wb.Worksheets(1).UsedRange
                .Copy destCell
                Set destCell = destCell.Offset(.Rows.Count)
            End With
            wb.Close False
        End If
        file = Dir
    Wend

End Sub

grab all the files that fall in a specific weekly time period and copy all the contents into a new worksheet.

What type of files are they? .csv, .xls, xlsx, etc. or something else?

What do you mean be all the contents? All worksheets, or only a worksheet with a specific name or index?

As written, the code imports the first worksheet from all .xlsx files in the folder.

The file names have the date and time included like this-"20230202085508"

Is that the whole file name or only part of it? If the latter, give examples.

 

[Herakles]

This line

fileDate = DateSerial(Mid(file, 1, 4), Mid(file, 5, 2), Mid(file, 8, 2))

needs to be

fileDate = DateSerial(Mid(file, 1, 4), Mid(file, 5, 2), Mid(file, 7, 2))

to get the day.

This code will import the header if the first row is a header but that is unknown as yet.

 

[John_w]

I miscounted! Thanks for the correction.

 

[trak]

Try something like this macro start with, though we need more specific details to give a solution which works exactly as you require.

Public Sub Import_Workbooks_for_Week()

    Dim folder As String
    Dim file As String
    Dim weekBeginningDate As Date
    Dim fileDate As Date
    Dim destCell As Range
    Dim wb As Workbook
  
    folder = "C:\path\to\folder\"    'CHANGE THIS
    weekBeginningDate = DateSerial(2023, 1, 22)   'CHANGE THIS
  
    With ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
        Set destCell = .Range("A1")
    End With
  
    If Right(folder, 1) <> "\" Then folder = folder & "\"
      
    file = Dir(folder & "*.xlsx")
    While file <> vbNullString
        fileDate = DateSerial(Mid(file, 1, 4), Mid(file, 5, 2), Mid(file, 8, 2))
        If fileDate >= weekBeginningDate And fileDate <= weekBeginningDate + 6 Then
            Set wb = Workbooks.Open(folder & file)
            With wb.Worksheets(1).UsedRange
                .Copy destCell
                Set destCell = destCell.Offset(.Rows.Count)
            End With
            wb.Close False
        End If
        file = Dir
    Wend

End Sub

What type of files are they? .csv, .xls, xlsx, etc. or something else?

What do you mean be all the contents? All worksheets, or only a worksheet with a specific name or index?

As written, the code imports the first worksheet from all .xlsx files in the folder.


Is that the whole file name or only part of it? If the latter, give examples.

Thanks for your reply! Apologies for leaving out that info.
All of the files are .csv and they only have one worksheet within, with all the same headers. So I would only need to grab the headers once and then second row on for the rest of them.
The file names also have ME_messagebroadcast at the end so "20230202085508ME_messagebroadcast"

 

[John_w]

Try this macro, but first change the settings near the top of the code. I've used a QueryTable rather than Workbooks.Open to import the .csv files.

Public Sub Import_csv_Files_for_Week()

    Dim folder As String
    Dim file As String
    Dim weekBeginningDate As Date
    Dim fileDate As Date
    Dim destCell As Range
    Dim csvStartRow As Long
    
    folder = "C:\path\to\folder\"    'CHANGE THIS
    weekBeginningDate = DateSerial(2023, 1, 22)   'CHANGE THIS
    
    With ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
        Set destCell = .Range("A1")
    End With
    csvStartRow = 1
    
    If Right(folder, 1) <> "\" Then folder = folder & "\"
        
    file = Dir(folder & "*.csv")
    While file <> vbNullString
        fileDate = DateSerial(Mid(file, 1, 4), Mid(file, 5, 2), Mid(file, 7, 2))
        If fileDate >= weekBeginningDate And fileDate <= weekBeginningDate + 6 Then
            With destCell.Worksheet.QueryTables.Add(Connection:="TEXT;" & folder & file, Destination:=destCell)
                .TextFileStartRow = csvStartRow
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileCommaDelimiter = True
                .Refresh BackgroundQuery:=False
                Set destCell = destCell.Offset(.ResultRange.Rows.Count)
                .Delete
            End With
            'Import next csv from row 2
            csvStartRow = 2
        End If
        file = Dir
    Wend

End Sub

 

[trak]

Try this macro, but first change the settings near the top of the code. I've used a QueryTable rather than Workbooks.Open to import the .csv files.

Public Sub Import_csv_Files_for_Week()

    Dim folder As String
    Dim file As String
    Dim weekBeginningDate As Date
    Dim fileDate As Date
    Dim destCell As Range
    Dim csvStartRow As Long
   
    folder = "C:\path\to\folder\"    'CHANGE THIS
    weekBeginningDate = DateSerial(2023, 1, 22)   'CHANGE THIS
   
    With ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
        Set destCell = .Range("A1")
    End With
    csvStartRow = 1
   
    If Right(folder, 1) <> "\" Then folder = folder & "\"
       
    file = Dir(folder & "*.csv")
    While file <> vbNullString
        fileDate = DateSerial(Mid(file, 1, 4), Mid(file, 5, 2), Mid(file, 7, 2))
        If fileDate >= weekBeginningDate And fileDate <= weekBeginningDate + 6 Then
            With destCell.Worksheet.QueryTables.Add(Connection:="TEXT;" & folder & file, Destination:=destCell)
                .TextFileStartRow = csvStartRow
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileCommaDelimiter = True
                .Refresh BackgroundQuery:=False
                Set destCell = destCell.Offset(.ResultRange.Rows.Count)
                .Delete
            End With
            'Import next csv from row 2
            csvStartRow = 2
        End If
        file = Dir
    Wend

End Sub

Awesome, this worked! Thank you for helping out!