AW: Bestimmten Inhaltz der Datei auslesen
31.05.2014 20:31:34
fcs
Hallo Selma,
nach folgend ein Makro, dass dir die Liste der Eintrage als Exceltabelle ausgibt.
Das mit der MsgBox ist doch mühselig zu lesen, speziell wenn die Liste etwas länger ist.
Gruß
Franz
'Code in einem allgemeinen Modul
Option Explicit
'Quelle: http://www. _
herber.de/forum/archiv/1064to1068/t1064122.htm#1064890
'Modifiziert: fcs 2010-08-07
Public lCount As Long, arrFiles() As String
Sub ListFilesInFolder(ByVal SourceFolderName As String, _
Optional DateiFormat As String = "*.*", _
Optional IncludeSubfolders As Boolean = False)
'1.Parameter Ordner, wo soll gesucht werden?
'2.Parameter Datei,* als Platzhalter verwenden,Optional leer ist alle
'3.Parameter mit Unterordner = True, Optional False ist ohne
'Erstellt gemäß Suchkriterien ein Array mit den Dateinamen und Pfad\Dateiname
Dim FSO As Object, SourceFolder As Object, SubFolder As Object
Dim FileItem
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
On Error GoTo Err_Zugriff: 'sollte Ordner geschützt sein
For Each FileItem In SourceFolder.Files
If LCase(FileItem.Name) Like LCase(DateiFormat) Then
lCount = lCount + 1
ReDim Preserve arrFiles(1 To 2, 1 To lCount)
arrFiles(1, lCount) = FileItem
arrFiles(2, lCount) = FileItem.Name
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, DateiFormat, IncludeSubfolders, FolderName
Next SubFolder
End If
Err_Zugriff:
Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub
Sub SearchINI_Dateien()
Dim Zeile As Long
Dim strVerzeichnis As String, strText As String, arrSplit As Variant
Dim wksListe As Worksheet
Dim FF As Integer
Dim bolGefunden As Boolean
Erase arrFiles
lCount = 0
strVerzeichnis = "D:\Einstellungen\users"
' strVerzeichnis = "C:\Users\Public\Test\Users"
Call ListFilesInFolder(SourceFolderName:=strVerzeichnis, _
DateiFormat:="*.INI", _
IncludeSubfolders:=True)
If lCount > 0 Then
'Neue Datei mit einem Blatt anlegen
Application.Workbooks.Add Template:=xlWBATWorksheet
Set wksListe = ActiveSheet
ActiveSheet.Range("A2").Select
ActiveWindow.FreezePanes = True
With wksListe
Zeile = 1
.Cells(Zeile, 1) = "Ordnername"
.Cells(Zeile, 2) = "Dateiname"
.Cells(Zeile, 3) = "_SYST_PROJECTNAME ="
For lCount = 1 To UBound(arrFiles, 2)
bolGefunden = False
arrSplit = Split(arrFiles(1, lCount), "\")
FF = FreeFile()
Open arrFiles(1, lCount) For Input As #FF
Do Until EOF(FF)
Line Input #FF, strText
If InStr(1, strText, "_SYST_PROJECTNAME =") > 0 Then
bolGefunden = True
Zeile = Zeile + 1
.Cells(Zeile, 1) = arrSplit(UBound(arrSplit) - 1)
.Cells(Zeile, 2) = arrFiles(2, lCount)
.Cells(Zeile, 3) = Trim(Mid(strText, InStr(1, strText, "=") + 1))
End If
Loop
If bolGefunden = False Then
Zeile = Zeile + 1
.Cells(Zeile, 1) = arrSplit(UBound(arrSplit) - 1)
.Cells(Zeile, 2) = arrFiles(2, lCount)
.Cells(Zeile, 3) = "#kein Eintrag vorhanden#"
End If
Erase arrSplit
Close FF
Next
Erase arrFiles
lCount = 0
With .Range(.Cells(2, 1), .Cells(Zeile, 3))
.Sort key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo
.EntireColumn.AutoFit
End With
End With
Else
MsgBox "keine Dateien gefunden"
End If
End Sub