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
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