Do Until rs.EOF
  rs2.MoveFirst
  nCount = 0
  ReDim sFound(0) As String
 
  Do Until rs2.EOF
   epos = InStr(rs("Tabellenfeld1"), rs2("Tabellenfeld2"))
   rest = Mid$(rs("Tabellenfeld1"), epos + Len(rs2("Tabellenfeld2")) + 1, 255)
 
    If epos > 0 Then  ' Vergleich erfolgreich
     nCount = nCount + 1
     ReDim Preserve sFound(nCount)
     sFound(nCount) = rs2("Tabellenfeld2")
 
    End If
 
    rs2.MoveNext
 
   Loop
 
       For I = 1 To nCount
       Print #1, sFound(nCount) + rest
    Next I
 
  rs.MoveNext
Loop