Problem hat sich erledigt. Wen es interessiert, hier der fertige Code:
Sub DateienAuflistenA5()
Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object
Set objFileSystem = CreateObject("scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder(Cells(5, 1))
Set objDateienliste = objVerzeichnis.Files
lngZeile = 8
lngZeile2 = Cells(1, 15) + lngZeile
For Each objDatei In objDateienliste
If Not objDatei Is Nothing Then
If Not ActiveSheet.Range("L8:L22").Find(objDatei.Name) Is Nothing Then
If ActiveSheet.Range("L8:L22").Find(objDatei.Name) = objDatei.Name Then
intRow = lngZeile
Do While Not ActiveSheet.Cells(intRow, 12) = objDatei.Name
intRow = intRow + 1
Loop
ActiveSheet.Cells(intRow, 5) = objDatei.Name
ActiveSheet.Cells(intRow, 10) = Right(objDatei.Name, 3)
MsgBox objDatei.Name & " gefunden in Zeile: " & intRow
End If
Else
ActiveSheet.Cells(lngZeile2, 5) = objDatei.Name
ActiveSheet.Cells(lngZeile2, 10) = Right(objDatei.Name, 3)
lngZeile2 = lngZeile2 + 1
MsgBox objDatei.Name & " nicht gefunden, Name wird in neue Zeile geschrieben."
End If
End If
Next objDatei
End Sub
|