web-dev-qa-db-de.com

Ordner durchlaufen, Dateien, die bestimmte Kriterien erfüllen, mit VBA umbenennen?

Ich bin neu in VBA (und habe nur ein bisschen Java-Training), habe aber dieses bisschen Code mit Hilfe anderer Beiträge hier zusammengestellt und bin gegen eine Wand gestoßen.

Ich versuche, Code zu schreiben, der jede Datei in einem Ordner durchläuft und prüft, ob jede Datei bestimmte Kriterien erfüllt. Wenn die Kriterien erfüllt sind, sollten die Dateinamen bearbeitet werden und vorhandene Dateien mit demselben Namen überschrieben (oder zuvor gelöscht) werden. Kopien dieser neu umbenannten Dateien sollten dann in einen anderen Ordner kopiert werden. Ich glaube, ich bin sehr nah dran, aber mein Code kann nicht alle Dateien durchlaufen und/oder Excel stürzt ab, wenn es ausgeführt wird. Hilfe bitte? :-)

Sub RenameImages()

Const FILEPATH As String = _
"C:\\CurrentPath"
Const NEWPATH As String = _
"C:\\AditionalPath"


Dim strfile As String
Dim freplace As String
Dim fprefix As String
Dim fsuffix As String
Dim propfname As String

Dim FileExistsbol As Boolean

Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")

strfile = Dir(FILEPATH)

Do While (strfile <> "")
  Debug.Print strfile
  If Mid$(strfile, 4, 1) = "_" Then
    fprefix = Left$(strfile, 3)
    fsuffix = Right$(strfile, 5)
    freplace = "Page"
    propfname = FILEPATH & fprefix & freplace & fsuffix
    FileExistsbol = FileExists(propfname)
      If FileExistsbol Then
      Kill propfname
      End If
    Name FILEPATH & strfile As propfname
    'fso.CopyFile(FILEPATH & propfname, NEWPATH & propfname, True)
  End If

  strfile = Dir(FILEPATH)

Loop

End Sub

Wenn es hilfreich ist, beginnen die Dateinamen mit ABC_mm_dd_hh_Page _ # .jpg. Ziel ist es, sie auf ABCPage # .jpg zu reduzieren

Vielen Dank SO!

5
Joe K

Ich halte es für eine gute Idee, zuerst alle Dateinamen in einem Array oder einer Sammlung zu sammeln, bevor Sie mit der Verarbeitung beginnen, insbesondere, wenn Sie sie umbenennen möchten. Wenn Sie keine Garantie haben, werden Sie Dir () nicht verwirren und Dateien überspringen oder die gleiche Datei zweimal verarbeiten. Auch in VBA müssen keine umgekehrten Schrägstriche in Zeichenfolgen vermieden werden.

Hier ist ein Beispiel mit einer Sammlung:

Sub Tester()

    Dim fls, f

    Set fls = GetFiles("D:\Analysis\", "*.xls*")
    For Each f In fls
        Debug.Print f
    Next f

End Sub



Function GetFiles(path As String, Optional pattern As String = "") As Collection
    Dim rv As New Collection, f
    If Right(path, 1) <> "\" Then path = path & "\"
    f = Dir(path & pattern)
    Do While Len(f) > 0
        rv.Add path & f
        f = Dir() 'no parameter
    Loop
    Set GetFiles = rv
End Function
2
Tim Williams

BEARBEITEN: Siehe Update unten für eine alternative Lösung.

Ihr Code hat ein großes Problem. Die letzte Zeile vor dem Ende von Loop lautet

   ...
   strfile = Dir(FILEPATH)  'This will always return the same filename

Loop
...

Hier ist, was Ihr Code sein sollte:

   ...
   strfile = Dir()  'This means: get the next file in the same folder

Loop
...

Wenn Sie zum ersten Mal Dir() aufrufen, sollten Sie einen Pfad zum Auflisten von Dateien angeben. Bevor Sie also die Schleife betreten, muss die Zeile:

strfile = Dir(FILEPATH)

ist gut. Die Funktion gibt die erste Datei zurück, die den Kriterien in diesem Ordner entspricht. Wenn Sie die Verarbeitung der Datei abgeschlossen haben und zur nächsten Datei wechseln möchten, sollten Sie Dir() aufrufen, ohne einen Parameter anzugeben, der angibt, dass Sie zur nächsten Datei iterieren möchten.

=======

Als alternative Lösung können Sie die für VBA bereitgestellte Klasse FileSystemObject verwenden, anstatt ein Objekt vom Betriebssystem zu erstellen.

Fügen Sie zunächst die Bibliothek "Microsoft Scripting Runtime" hinzu, indem Sie zu Extras-> Verweise-> Microsoft Scripting Runtime wechseln

enter image description hereenter image description here

Falls Sie [Microsoft Scripting Runtime] nicht aufgelistet haben, navigieren Sie einfach zu C:\windows\system32\scrrun.dll und das sollte auch so sein.

Ändern Sie zweitens Ihren Code, um die referenzierte Bibliothek wie folgt zu verwenden:

Die folgenden zwei Zeilen:

Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")

sollte durch diese einzelne Zeile ersetzt werden:

Dim fso As New FileSystemObject

Führen Sie jetzt Ihren Code aus. Wenn Sie diesmal immer noch auf einen Fehler stoßen, sollte der Fehler im Gegensatz zu dem allgemeinen Fehler, der von dem vagen Objekt aus der Vergangenheit bereitgestellt wurde, detailliertere Informationen zu seinem Ursprung enthalten.

3
Ahmad

Falls sich jemand wundert, hier ist mein fertiger Code. Vielen Dank an Tim und Ahmad für ihre Hilfe!

Sub RenameImages()

Const FILEPATH As String = "C:\CurrentFilepath\"
Const NEWPATH As String = "C:\NewFilepath\"


Dim strfile As String
Dim freplace As String
Dim fprefix As String
Dim fsuffix As String
Dim propfname As String
Dim fls, f

Set fls = GetFiles(FILEPATH)
For Each f In fls
    Debug.Print f
    strfile = Dir(f)
      If Mid$(strfile, 4, 1) = "_" Then
        fprefix = Left$(strfile, 3)
        fsuffix = Right$(strfile, 5)
        freplace = "Page"
        propfname = FILEPATH & fprefix & freplace & fsuffix
        FileExistsbol = FileExists(propfname)
          If FileExistsbol Then
          Kill propfname
          End If
        Name FILEPATH & strfile As propfname
        'fso.CopyFile(FILEPATH & propfname, NEWPATH & propfname, True)
      End If
Next f
End Sub

Function GetFiles(path As String, Optional pattern As String = "") As Collection
    Dim rv As New Collection, f
    If Right(path, 1) <> "\" Then path = path & "\"
    f = Dir(path & pattern)
    Do While Len(f) > 0
        rv.Add path & f
        f = Dir() 'no parameter
    Loop
    Set GetFiles = rv
End Function

Function FileExists(fullFileName As String) As Boolean
    If fullFileName = "" Then
        FileExists = False
    Else
        FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
    End If
End Function
1
Joe K