Private Sub CommandButton1_Click()
If UserForm1.OrdnerPfad.Value = "" Then
MsgBox "Bitte Pfad kopieren"
Exit Sub
Else
End If
If UserForm1.NeuerOrdnerName.Value = "" Then
MsgBox "Bitte Ordnernamen eingeben"
Exit Sub
Else
End If
Call DateinamenUmbenennen.RDB_Copy_Sheet
End Sub
------------------------------------
Option Explicit
Sub RDB_Copy_Sheet()
Dim FSO As Object
Dim objFSO As Object
Dim objOrdner As Object
Dim Protokolle_Kurz
Dim g As Object
Dim Pfad As String
Dim fldr As Object
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.CreateFolder(Pfad & UserForm1.NeuerOrdnerName.Text)
Set FSO = CreateObject("scripting.filesystemobject")
Set fldr = FSO.getfolder(Pfad)
Dim datei, c
Dim NeuerName As String
For Each datei In fldr.Files
If datei.Name Like "*M6201*" Then
NeuerName = "A10St1"
ElseIf datei.Name Like "*M6202*" Then
NeuerName = "A10St2"
c = FSO.copyfile(datei, Pfad & NeuerName, True)
End If
Next
MsgBox "Alles läuft durch"
End Sub