Well here is a condensed version (currently does not work properly but close).
Perhaps Jooel or Mart or someone else has the time to help you complete it.

The issue is in how the Open/Read/Write works - it finds
the data, but then writes multiple times which it
shouldn't do - just don't have time to further debug it.



Break On
Dim $SO
$SO=SetOption('Explicit','On')
$SO=SetOption('NoVarsInStrings','On')
$SO=SetOption('NoMacrosInStrings','On')
 
Dim $Path, $File, $Folder, $Folders, $FileData
Dim $Date, $Nul, $R, $2, $3
$Date = '1/1/2006'
$File = 'logfile.txt'
$Path = 'C:\Office\Type'
$Folders = DirL($Path)
For Each $Folder In $Folders
  If $Folder
    $Nul = Open(1,$Path+'\'+$Folder+'\'+$File)
    $R = Readline(1)
    While @Error = 0
      $2 = Split($R,CHR(9))
      If InStr($2[1],$Date)
        $Nul = Open(2,'C:\TEMP\Compile.TXT',5)
        While @Error = 0
          $Nul = Writeline(2,$R+@crlf)
          $R Readline(1)
        Loop
      EndIf
      $R = Readline(1)
    Loop
    Close(1)
    Close(2)
  EndIf
Next
 
Function DirL($f)
  Dim $a[0]
  $f = Dir($f)
  While Not @ERROR
    If $f <> '..' And $f <> '.'
      $a[UBound($a)] = $f
      ReDim Preserve $a[UBound($a)+1]
    EndIf
    $f = Dir()
  Loop
  If UBound($a)
    ReDim Preserve $a[UBound($a)-1]
  Else
    $a = 0
  EndIf
  $DirL = $a
EndFunction