habe ein problem mit den untenstehenden Code (ist aus einen Anderen Forum) funktioniert abgeändert für Word 2007
was mache ich falsch dass dieser code für Excel 2007 läuft.
1. Fehler: nichtr alle dateien werden in das tabellenblatt eingelesen.
2. die meldung die kommt zeigt mehr dateien an als tatsächlich eingelesen worden sind.
bitte um eure hilfe, was ich ändern muss.
Beispiel Datei
https://www.herber.de/bbs/user/61300.xls
Sub Dateisuche()
Dim lngAkt As Long
Dim Pfad As String ' Suchordner
Dim Muster As String 'Suchmuster
Dim Dateiname As String
Dim Meldung As String
' Die Collection dient als Ergebnis, analog zur Foundfiles Auflistung
Dim Liste As New Collection
Cells.Select
Selection.ClearContents
Pfad = "O:\Lackiererei_w6\50_Produktion\100_TR_340\080_Methodiker\0804_Verwaltung_Methodik\ _
08042_Verwaltung_Schoierer\04201_Dichtheit\"
Cells(1, 2).Value = Pfad
Muster = msoFileTypeOfficeFiles
'Die Dir Funktion liefert die erste Datei im Suchordner als String
Dateiname = Dir$(Pfad)
Do While Len(Dateiname) > 0
'Die Instr Funktion vergleicht Dateiname mit Suchmuster
If InStr(1, Dateiname, Muster, vbTextCompare) > 0 Then
'Ausgabe ins Dokument
'Selection.TypeText Pfad & Dateiname & vbCrLf
For lngAkt = 1 To Liste.Count
Cells(lngAkt, 1) = Mid(Liste.Item(lngAkt), Len(Pfad) + 1)
Next lngAkt
'Hinzufügen der gefundenen Dateien zur Collection
Liste.Add (Pfad & Dateiname)
End If
'um weitere Dateinamen über die Dir Funktion zu erhalten, reicht ein erneuter aufruf ohne _
_
_
Parameter
Dateiname = Dir$
Meldung = "Es wurden " & Liste.Count & _
" Dateien gefunden." & vbCrLf
Loop
If Liste.Count 0 Then
MsgBox Meldung, vbInformation, "Dateisuche"
End If
End Sub
mfg
Erich