Combine txt file according to date filter (VBA)

[2avrham]

Hi,

Im using below code to combine txt files to one excel sheet data file.

I need to edit my code to "take" files only from the last 7 days.

Any idea how to do that?

Thanks!!

Code:

Sub list()

Dim xSht As Worksheet
Dim xWb As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder [Kutools for Excel]"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
Set xSht = ThisWorkbook.ActiveSheet
If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "" & "*.txt")

Do While xFile <> ""
Set xWb = Workbooks.Open(xStrPath & "" & xFile)
Columns(1).Insert xlShiftToRight
Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close False
xFile = Dir
Loop
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "no txt files ", , "Kutools for Excel"
End Sub

 

[2avrham]

Up please...

 

[John_w]

Try this:

    Do While xFile <> vbNullString
        If Date - Int(FileDateTime(xStrPath & "\" & xFile)) <= 7 Then
            Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
            Columns(1).Insert xlShiftToRight
            Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
            ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            xWb.Close False
        End If
        xFile = Dir
    Loop

Always use CODE tags.