AW: Dateien in Ordner überprüfen
28.01.2016 12:43:52
fcs
Hallo Michael,
nachfolgend mein Vorschlag.
Ergänzend zur MsgBOx kannst du in einer weiteren Spalte der Liste auch eine Markierung bei den nicht vorhandenen Dateien eintragen. Die entsprechenden Zeilen sind als Kommentar im Code.
Gruß
Franz
'Makro in einem allgemeinen Modul
Sub prcCheckDateien_2()
Dim wksZiel As Worksheet
Dim Zeile As Long
Dim strFragment As String
Dim varOrdner As Variant, varDatei
Dim strMsg As String
Set wksZiel = ActiveSheet
'Ordner auswählen - oder anders vorgeben
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte den Ordner mit den Text-Dateien auswählen"
If .Show = -1 Then
varOrdner = .SelectedItems(1)
Else
GoTo Beenden
End If
End With
Application.ScreenUpdating = False
With wksZiel
'Zeilen abarbeiten
For Zeile = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
strFragment = .Cells(Zeile, 2).Text
'Dateienamen im Ordner
varDatei = Dir(varOrdner & "\*" & strFragment & "*")
If varDatei "" Then
'.Cells(Zeile, 3).ClearContents 'Markierung löschen
Else
strMsg = strMsg & vbLf & .Cells(Zeile, 1).Text & " - " & strFragment
'.Cells(Zeile, 3).Value = "nicht vorhanden" 'Markierung setzen
End If
Next
If strMsg "" Then
MsgBox "Folgende Dateien wurden nicht gefunden" & strMsg, _
vbOKOnly + vbInformation, "Dateisuche"
End If
End With
Beenden:
Application.ScreenUpdating = True
End Sub