Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1728to1732
1728to1732
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Über Dateinamen Ordner erstellen und Dateien verschieben

Forumthread: Über Dateinamen Ordner erstellen und Dateien verschieben

Über Dateinamen Ordner erstellen und Dateien verschieben
09.12.2019 11:29:56
Mario
Guten Morgen,
zum einen erstmal vielen Dank für dieses großartige Forum und euch unglaublich hilfsbereiten Mitglieder. Bisher konnte ich alle meine Scripte durch mitlesen, lernen und entsprechend ändern problemlos anpassen. Jetzt bräuchte ich allerdings doch mal eure direkte Hilfe.
Ich habe eine Excel erstellt die mir verschiedene Anfragen als PDF erstellt und in einem Ordner speichert. Dabei haben alle PDF-Dateien einen ähnlichen Namen, z.b. "LST 123456789.PDF", "Bestellung 987654321.pdf" etc. Es ist immer eine 9-stellige Nummer vor dem Punkt mit der Dateiendung.
Ich möchte jetzt gerne einen Button einbinden dessen Script soll dann in einem bestimmten Ordner nachsehen ob Dateien vorhanden sind, wenn ja diese entsprechend der 9-stelligen Nummer im Dateinamen in einen Ordner mit dieser 9-Stelligen Zahl verschieben. Wenn der Ordner nicht existiert, dann erst erstellen und dann verschieben.
Ich habe ein Script hier gefunden das etwas ähnliches durchführt. Nur komme ich nicht drauf wie ich nur die letzten 9 Stellen des Dateinamens benutzen kann, und wie ich die Schleife aufbauen muss, damit das Script so lange durchläuft bis keine Datei mehr im Ordner vorhanden ist.
Hier mal das gefundene Script:
Sub File_verschieben()
Dim Quelle$, Ziel$, FSO As Object
Quelle = "C:\abc\LN*.*"
If Dir(Quelle) = "" Then
MsgBox "Keine Dateien vorhanden!"
Else
Ziel = "V:\xyz\"
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.MoveFile Quelle, Ziel
Set FSO = Nothing
End If
End Sub
Könnt Ihr mit bitte bei dem Problem helfen ?
vielen Dank für eure Mühe.
Mario
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Über Dateinamen Ordner erstellen und Dateien verschieben
09.12.2019 12:14:24
Mario
Ich hätte es jetzt im Prinzip so erstellt:
    Dim Quelle$, Ziel$, FSO As Object
While Dir(Quelle)  ""
Quelle = "D:\Users\BKU\mariodittrich\Desktop\Baumappe\EM IH*.pdf"
Quelle = "D:\Users\BKU\mariodittrich\Desktop\Baumappe\LST IH*.pdf"
Quelle = "D:\Users\BKU\mariodittrich\Desktop\Baumappe\FWD Bestellung IH*.pdf"
Quelle = "D:\Users\BKU\mariodittrich\Desktop\Baumappe\1. Seite IH*.pdf"
If Dir(Quelle) = "" Then
MsgBox "Keine Dateien vorhanden!"
Else
Ziel = "D:\Users\BKU\mariodittrich\Desktop\Baumappe 2\"
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.MoveFile Quelle, Ziel
'Set FSO = Nothing
End If
Wend
allerdings überschreibe ich ja so jedes mal die Variable Quelle, so dass nur die letzte Zeile bearbeitet wird. (Bei c++ würde ich eine Schleife mit einem Inkrementor nehmen, in VBA hab ich keine Ahnung)
Ausserdem kopiert er es ja so in einen fixen Ordner, und nicht in einen der zu der Nummer passt.
Steh komplett aufm Schlauch.
Anzeige
AW: Über Dateinamen Ordner erstellen und Dateien verschieben
09.12.2019 12:22:35
Nepumuk
Hallo Mario,
teste mal:
Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long
Private Declare PtrSafe Function MoveFileA Lib "kernel32.dll" ( _
    ByVal lpExistingFileName As String, _
    ByVal lpNewFileName As String) As Long

Public Sub File_verschieben()
    
    Const SOURCE_FOLDER As String = "H:\1209\" ' Anpassen !!!
    Const TARGET_FOLDER As String = "G:\1209\" ' Anpassen !!!
    
    Dim strFileName As String, strTargetFolder As String
    Dim lngNumber As String, lngCounter As Long
    
    On Error GoTo err_exit
    
    strFileName = Dir$(SOURCE_FOLDER & "*.pdf")
    
    Do Until strFileName = vbNullString
        lngNumber = ExtractNumber(strFileName)
        If lngNumber > 0 Then
            strTargetFolder = TARGET_FOLDER & CStr(lngNumber) & "\"
            If MakeSureDirectoryPathExists(strTargetFolder) = 0 Then
                Call Err.Raise(Number:=vbObjectError + 70, Description:="Zugriffsfehler")
            Else
                If MoveFileA(SOURCE_FOLDER & strFileName, strTargetFolder & strFileName) = 0 Then
                    Call Err.Raise(Number:=vbObjectError + 1004, Description:="Kopierfehler")
                End If
            End If
            lngCounter = lngCounter + 1
        End If
        strFileName = Dir$
    Loop
    If lngCounter = 0 Then
        Call MsgBox("Keine Dateien zum verschieben gefunden.", vbExclamation, "Hinweis")
    Else
        Call MsgBox(CStr(lngCounter) & " Dateien verschoben.", vbInformation, "Information")
    End If
    Exit Sub
    err_exit:
    Call MsgBox("Fehler " & CStr(Err.Number) & vbLf & vbLf & Err.Description, vbCritical, "Fehler")
End Sub

Private Function ExtractNumber(ByVal prstrFileName As String) As Long
    Dim objRegEx As Object, objMatch As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .MultiLine = True
        .Global = True
        .IgnoreCase = False
        .Pattern = "\d{9}"
        Set objMatch = .Execute(prstrFileName)
    End With
    If objMatch.Count > 0 Then ExtractNumber = objMatch.Item(0)
End Function

Gruß
Nepumuk
Anzeige
AW: Über Dateinamen Ordner erstellen und Dateien verschieben
09.12.2019 12:36:49
Mario
WOW !
Perfekt. Vielen vielen Dank für deine Unterstützung ! Das funktioniert ja perfekt.
Jetzt muss ich mich mal damit beschäftigen und Schritt für Schritt lernen was es genau tut.
Vielen Dank an dich nochmal !
Gruss
Mario
;
Anzeige
Anzeige

Infobox / Tutorial

Dateinamen analysieren, Ordner erstellen und Dateien verschieben in Excel VBA

Schritt-für-Schritt-Anleitung

Um ein Excel-Skript zu erstellen, das Dateien basierend auf ihrem Namen in entsprechende Ordner verschiebt, folge diesen Schritten:

  1. Öffne Excel und drücke ALT + F11, um den VBA-Editor zu öffnen.

  2. Füge ein neues Modul hinzu:

    • Rechtsklick auf "VBAProject (DeineDatei.xlsx)" > Einfügen > Modul.

  3. Kopiere und füge den folgenden Code ein:

    Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
   ByVal DirPath As String) As Long
Private Declare PtrSafe Function MoveFileA Lib "kernel32.dll" ( _
   ByVal lpExistingFileName As String, _
   ByVal lpNewFileName As String) As Long

Public Sub File_verschieben()
   Const SOURCE_FOLDER As String = "C:\DeinQuellOrdner\" ' Anpassen !!!
   Const TARGET_FOLDER As String = "C:\DeinZielOrdner\" ' Anpassen !!!
   Dim strFileName As String, strTargetFolder As String
   Dim lngNumber As String, lngCounter As Long

   strFileName = Dir$(SOURCE_FOLDER & "*.pdf")

   Do Until strFileName = vbNullString
       lngNumber = ExtractNumber(strFileName)
       If lngNumber > 0 Then
           strTargetFolder = TARGET_FOLDER & CStr(lngNumber) & "\"
           If MakeSureDirectoryPathExists(strTargetFolder) = 0 Then
               Call Err.Raise(Number:=vbObjectError + 70, Description:="Zugriffsfehler")
           Else
               If MoveFileA(SOURCE_FOLDER & strFileName, strTargetFolder & strFileName) = 0 Then
                   Call Err.Raise(Number:=vbObjectError + 1004, Description:="Kopierfehler")
               End If
               lngCounter = lngCounter + 1
           End If
       End If
       strFileName = Dir$
   Loop

   If lngCounter = 0 Then
       Call MsgBox("Keine Dateien zum verschieben gefunden.", vbExclamation, "Hinweis")
   Else
       Call MsgBox(CStr(lngCounter) & " Dateien verschoben.", vbInformation, "Information")
   End If
End Sub

Private Function ExtractNumber(ByVal prstrFileName As String) As Long
   Dim objRegEx As Object, objMatch As Object
   Set objRegEx = CreateObject("VBScript.RegExp")
   With objRegEx
       .MultiLine = True
       .Global = True
       .IgnoreCase = False
       .Pattern = "\d{9}"
       Set objMatch = .Execute(prstrFileName)
   End With
   If objMatch.Count > 0 Then ExtractNumber = objMatch.Item(0)
End Function

  4. Passen die Quell- und Zielordner an den Code an.

  5. Führe das Skript aus und beobachte, wie die Dateien in die entsprechenden Ordner verschoben werden.

Häufige Fehler und Lösungen

  • Fehler: "Zugriffsfehler"

    • Lösung: Stelle sicher, dass du die notwendigen Berechtigungen für den Zielordner hast. Überprüfe auch, ob der Pfad korrekt ist.

  • Fehler: "Kopierfehler"

    • Lösung: Überprüfe, ob die Datei bereits im Zielordner vorhanden ist oder ob der Zielordner korrekt erstellt wurde.

  • Keine Dateien gefunden

    • Lösung: Vergewissere dich, dass die PDFs im Quellordner tatsächlich vorhanden sind und den richtigen Namenskonventionen entsprechen.

Alternative Methoden

Wenn du keine VBA-Lösungen verwenden möchtest, kannst du auch:

  • Excel-Funktionen verwenden, um Dateinamen zu extrahieren und manuelle Kopierschritte auszuführen.
  • Batch-Dateien oder PowerShell-Skripte nutzen, um Dateien basierend auf Namensmustern zu verschieben.

Praktische Beispiele

  1. Beispiel 1: Du hast mehrere PDFs mit dem Namen "Bestellung 123456789.pdf". Das obige Skript wird diese Datei in den Ordner C:\DeinZielOrdner\123456789\ verschieben.

  2. Beispiel 2: Wenn der Quellordner C:\Dokumente\ heißt und die PDFs nicht existieren, wird eine entsprechende Fehlermeldung angezeigt.

Tipps für Profis

  • Nutze Option Explicit am Anfang deines Codes, um sicherzustellen, dass alle Variablen deklariert sind – das hilft, Fehler zu vermeiden.
  • Setze Fehlerbehandlungsroutinen ein, um den Code robuster zu gestalten und spezifische Fehler zu protokollieren.
  • Experimentiere mit Debug.Print-Befehlen, um während der Entwicklung zu sehen, welche Werte in den Variablen gespeichert sind.

FAQ: Häufige Fragen

1. Wie kann ich das Skript anpassen, um andere Dateiformate zu verarbeiten? Du kannst die Zeile strFileName = Dir$(SOURCE_FOLDER & "*.pdf") ändern, um andere Dateiformate zu unterstützen, z.B. *.txt für Textdateien.

2. Ist dieses Skript mit allen Excel-Versionen kompatibel? Das Skript sollte in Excel 2010 und neueren Versionen funktionieren, solange die VBA-Funktionalität verfügbar ist. Achte darauf, dass du die richtigen Bibliotheken aktiviert hast, falls erforderlich.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige