|
1. du fügst die gefundenen dateinamen immer nur in die selbe Zelle ein. Somit überschreibst du einen evtl vorher gefundenen Wert mit dem Nächsten.
Teste mal das. ich habs nicht getestet.
Dim strPfad As String, strDatei As String, vn As String, nn As String
Dim rngName As Range
Dim arrName
strPfad = "Z:\Pfad"
strDatei = Dir(strPfad & "\*.pdf")
If strDatei = "" Then MsgBox "Keine Dateien vorhanden", vbCritical, "Abbruch": Exit Sub
arrName = Split(strDatei, " ")
vn = arrName(1)
nn = arrName(0)
Do
Set rngName = Columns(4).Find(nn, lookat:=xlWhole)
If Not rngName Is Nothing Then
If rngName.Offset(0, 1) = vn Then
If rngBild.Offset(0, 2) = "" Then
rngBild.Offset(0, 2) = strDatei
Else
If vbYes = MsgBox("Eine Datei ist schon eingetragen. Überschreiben?" & vbCrLf & rngBild.Offset(0, 2).Value, _
vbYesNo + vbInformation + vbDefaultButton1, _
"Warnung") Then
rngBild.Offset(0, 2) = strDatei
End If
End If
End If
End If
strDatei = Dir
Loop While strDatei <> ""
|