Dateien finden umbenennen und kopieren
14.10.2019 08:51:54
Joseph
ich bin auf der Suche nach meinem Fehler für folgende Aufgabe:
Ein Ordner soll durchsucht werden und alle Dateien, die am Anfang ein "ERT" tragen, sollen in einen anderen Ordner kopiert und umbenannt werden.
Mein momentaner Stand sieht so aus, funktioniert aber nicht. Ich scheitere schon beim finden und kopieren der Dateien. Könnte sich das bitte jamand ansehen?
Danke und viele Grüße
Option Explicit
Option Compare Text
Const sRootPath As String = "C:\Users\DEU216531\Desktop\Volvo\VC Backup\PLC3a\"
Public Sub DateienMitUnterordnernAuslesen()
Call ReadSubFolder(sRootPath)
End Sub
Private Sub ReadSubFolder(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim Dateiname As String
Dim Verzeichnisname As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)
For Each oSubFolder In oFolder.subfolders
For Each oFile In oSubFolder.Files
If UCase(Left(oFile.Name, 3)) = "ERT" Then
Dateiname = oFile.Name
Verzeichnisname = oSubFolder.Name
oFSO.getfile(Verzeichnisname & Dateiname).Copy ("C:\neu\")
End If
Next oFile
Call ReadSubFolder(oSubFolder.Path)
Next oSubFolder
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
End Sub