Private FSO As New FileSystemObject
 
Public Sub OrdnerSuchen(ByVal sPfad As String)
 
  Dim fsoFolder As Folder
  Dim fsoSubFolder As Folder
  Dim fsoFile As File
 
  Set fsoFolder = FSO.GetFolder(sPfad)
 
  If LCase(fsoFolder.Name) = "pref" Then
    For Each fsoFile In fsoFolder.Files
      If LCase(Right(fsoFile.Name, 3)) = "ini" Then
        Call schreibInWord(fsoFile.Path)
      End If
    Next fsoFile
  Else
    'Unterordner durchsuchen
    If fsoFolder.SubFolders.Count > 0 Then
      For Each fsoSubFolder In fsoFolder.SubFolders
        'rekursiver Aufruf der Funktion
        Call OrdnerSuchen(fsoSubFolder.Path)
      Next fsoSubFolder
    End If
  End If
 
End Sub
 
 
Public Sub schreibInWord(ByVal sIniDatei As String)
 
  Dim W As New Word.Application
  Dim F As Integer
  Dim sSatz As String
 
  W.Documents.Open App.Path & "\INI.doc"
 
  F = FreeFile
  Open sIniDatei For Input As F
    While Not EOF(F)
      Line Input #F, sSatz
      W.ActiveDocument.Range.InsertAfter (sSatz & vbCrLf)
    Wend
  Close #F
 
  W.ActiveDocument.Save
  W.ActiveDocument.Close
 
  Set W = Nothing
 
End Sub