AW: offen für alle..
22.01.2019 14:48:28
UweD
Hi.
Prima, das es klappt.
Hier eine Variante, die das berücksichtigt.
Sub test()
Dim TB, Z1 As Integer, HSp As Integer
Dim fso As Object, f1 As Object
Dim ziel As Range, quelle As Range, NurPfad As String
Dim AnzahlDat As Long, a As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set TB = ActiveWorkbook.Sheets("Tabelle1")
Z1 = 2 'ggf Überschrift beachten
HSp = 2 'Offset für Hinweisspalte >>>> Hier in C
With TB
AnzahlDat = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
'Reset Hinweise
.Columns(1).Offset(, HSp).ClearContents
For a = Z1 To AnzahlDat
If .Cells(a, 1) > "" And .Cells(a, 2) > "" Then
Set quelle = .Cells(a, 1)
With quelle.Offset(0, 1)
.Value = IIf(Right(.Value, 1) = "\", .Value, .Value & "\")
Set ziel = .Cells
End With
NurPfad = Left(quelle, InStrRev(quelle, "\"))
If fso.FolderExists(NurPfad) Then
If fso.fileExists(quelle) Then
If fso.FolderExists(ziel) Then
Set f1 = fso.GetFile(quelle)
f1.Copy (ziel)
Else
quelle.Offset(0, HSp) = "Achtung - Zielverzeichnis nicht vorhanden"
End If
Else
quelle.Offset(0, HSp) = "Achtung - Datei nicht vorhanden"
End If
Else
quelle.Offset(0, HSp) = "Achtung - Quellverzeichnis nicht vorhanden"
End If
End If
Next a
End With
Set fso = Nothing
Set quelle = Nothing
Set ziel = Nothing
End Sub
LG UweD