open txt files with VBA which meet date criteria naming convention includes date-CodePudding

I am using software which generates a logfile everyday, and my technicians need to check the logs and I want to make it as easy as possible, I have a script that was used previously, where the techs enter the first and last date in cells M2 and O2 these dates are then converted to the format which corresponds to the file name:

    Sheets("Intake reports").Select
    Range("M2").Select                           'Get date of 1st day
    BCDate = ActiveCell
    Application.ScreenUpdating = False
    BCday = Left(BCDate, 2)
    BCmonth = Mid(BCDate, 4, 2)
    BCyear = Right(BCDate, 2)
    BCDate1st = BCyear   BCmonth   BCday
    
    Range("O2").Select                           'Get date of 2nd day
    BCDate = ActiveCell
    Application.ScreenUpdating = False
    BCday = Left(BCDate, 2)
    BCmonth = Mid(BCDate, 4, 2)
    BCyear = Right(BCDate, 2)
    BCDate2nd = BCyear   BCmonth   BCday
     
    Application.DisplayAlerts = False

Then it opens the two files and copies them into a worksheet:

                                        'Load 1st BC log file
    '
        Workbooks.OpenText Filename:="C:\Users\1548013\Desktop\Logfiles\BC"   BCDate1st   ".LOG", Origin:= _
         xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
        False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
        , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
        Array(23, 1), Array(24, 1), Array(25, 1)), TrailingMinusNumbers:=True
          LastRow1st = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
          'Selection.SpecialCells(xlCellTypeLastCell).Select  Line 1 of 2
          'TheLastRow = ActiveCell.Row                        Line 2 of 2
    Range("a1:x" & LastRow1st).Select
    Selection.Copy
   ' Windows("Log Template.xlsm").Activate
   Windows("filename.xlsm").Activate
    Sheets("LogTemplate").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("BC"   BCDate1st   ".LOG").Activate
    ActiveWindow.Close
    Application.DisplayAlerts = False
    
   ' Workbooks.OpenText Filename:="I:\KMcK\LogFiles\BC"   BCDate2nd   ".LOG", Origin:=
    
                                             'Load 2nd BC log file
     Workbooks.OpenText Filename:="C:\Users\1548013\Desktop\Logfiles\BC"   BCDate2nd   ".LOG", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
        False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
        , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
        Array(23, 1), Array(24, 1), Array(25, 1)), TrailingMinusNumbers:=True
          LastRow2nd = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    Range("a1:x" & LastRow2nd).Select
    Selection.Copy
    Windows("filename").Activate
  '  Windows("filename").Activate
    Sheets("LogTemplate").Select
    Range("A" & LastRow1st   1).Select
    ActiveSheet.Paste
    Windows("BC"   BCDate2nd   ".LOG").Activate
    ActiveWindow.Close

This only works for two consecutive days, as each day is a separate file. I would like to enter the start date of the study in M2 and today's date in o2 and the script opens and imports every file between the two dates (inclusive).

thanks in advance

CodePudding user response：

Option Explicit
Sub IntakeReports()

    Const FOLDER = "C:\Users\1548013\Desktop\Logfiles\" '

    Dim wb As Workbook
    Dim rngSrc As Range, rngTarget As Range
    Dim dtFirst As Date, dtLast As Date, dt As Date
    Dim n As Long, i As Long
    Dim logfile As String, msg As String
    
    Set wb = ThisWorkbook
    With wb.Sheets("IntakeReports")
        dtFirst = .Range("M2").Value2
        dtLast = Now
    End With
    n = DateDiff("d", dtFirst, dtLast)   1
    
    If n < 1 Then
        MsgBox "End date must be after start date", vbCritical
        Exit Sub
    Else
        msg = Format(dtFirst, "dd-mmm-yy") & " to " & _
              Format(dtLast, "dd-mmm-yy") & vbLf & _
              vbLf & "Read " & n & " reports ?"

        If vbNo = MsgBox(msg, vbYesNo, "Confirm") Then
             Exit Sub
        End If
        msg = ""
        
    End If
    
    ' select report folder
    Dim fso As Object, sFolder As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .InitialFileName = FOLDER
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If
        sFolder = .SelectedItems(1) 'Assign selected folder to ParentFolder
    End With
    If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    
    ' target cell for copy
    Set rngTarget = wb.Sheets("LogTemplate").Range("A1")
    
    ' loop though dates
    Application.ScreenUpdating = False
    n = 0
    For dt = dtFirst To dtLast
        logfile = "BC" & Format(dt, "yymmdd") & ".LOG"
        
        ' check file exists
        If fso.FileExists(sFolder & logfile) Then
            
            Workbooks.OpenText Filename:=sFolder & logfile, Origin:= _
             xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
            , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
            False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
            , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
            Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
            16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
            Array(23, 1), Array(24, 1), Array(25, 1)), TrailingMinusNumbers:=True
            With ActiveWorkbook
                Set rngSrc = .Sheets(1).UsedRange
                rngSrc.Copy rngTarget
                Set rngTarget = rngTarget.Offset(rngSrc.Rows.Count)
                .Close
            End With
            i = i   1
        Else
            n = n   1
            msg = msg & vbLf & logfile
        End If
          
    Next
    Application.ScreenUpdating = True

    ' result
    If n > 0 Then msg = vbLf & n & " logs not found" & msg
    msg = i & " logs found" & msg
    MsgBox msg, vbInformation, sFolder
 
End Sub