Sub bb()
      Const FLDR = "c:\temp\"
      Dim s$, s2$, f$, k1%, k2%, b As Boolean, i&
      With Workbooks.Add(xlWBATWorksheet).Sheets(1)
          f = Dir(FLDR & "*.txt")
          While f <> ""
              k1 = FreeFile
              Open FLDR & f For Input Access Read As #k1
              k2 = FreeFile
              Open FLDR & "~" & f For Output Access Write As #k2
              b = False
              While Not EOF(k1)
                  Line Input #k1, s
                  Select Case True
                  Case s Like "*XFS CIM Service Provider*"
                      i = i + 1
                      .Cells(i, 1) = s
                      .Cells(i, 2) = f
                      b = True
                  Case s Like "*XFS CAM Service Provider*"
                      i = i + 1
                      .Cells(i, 1) = s
                      .Cells(i, 2) = f
                      b = True
                  Case Else
                      Print #k2, s
                  End Select
              Wend
              Close k1, k2
              If b Then
                  Kill FLDR & f
                  Name FLDR & "~" & f As FLDR & f
              Else
                  Kill FLDR & "~" & f
              End If
              f = Dir
          Wend
      End With
End Sub