Option
Explicit
Sub
Ordner_Auslesen()
ungetestet !!!!
Dim
fso
As
Object
Dim
rng
As
Range
Dim
sPfad
As
String
Dim
Dateiliste
As
Variant
Dim
Datei
As
Variant
sPfad = ActiveSheet.Range(
"A1"
).Value
Set
fso = CreateObject(
"Scripting.FileSystemObject"
)
If
fso.FolderExists(sPfad)
Then
Set
Dateiliste = fso.getfolder(sPfad).Files
For
Each
Datei
In
Dateiliste
Debug.Print Datei.Name
Set
rng = ActiveSheet.Range(
"D2:D292"
).Find(what:=Datei.Name, LookIn:=xlValues, lootat:=xlPart)
If
Not
rng
Is
Nothing
Then
Datei.Name = Replace(Datei.Name, rng.Value, rng.Offset(, 1).Value)
End
If
Next
Datei
Else
MsgBox
"Dieser Ordner existiert nicht."
End
If
End
Sub