Thema Datum  Von Nutzer Rating
Antwort
Rot Excel VBA MoveFile - Zielpfad in Unterordner ermitteln
24.09.2021 22:50:20 Elmo84
NotSolved
25.09.2021 08:50:48 Gast60693
NotSolved
25.09.2021 13:53:22 Elmo84
NotSolved
26.09.2021 23:34:13 Nobody
NotSolved
27.09.2021 17:33:34 Elmo84
NotSolved
27.09.2021 18:32:49 Gast35658
NotSolved
27.09.2021 18:38:40 Nobody
NotSolved
27.09.2021 19:03:50 Elmo84
NotSolved
27.09.2021 20:00:18 Nobody
NotSolved
28.09.2021 11:54:37 Nobody
NotSolved
28.09.2021 21:03:34 Nobody
NotSolved
03.10.2021 13:16:13 elmo84
NotSolved

Ansicht des Beitrags:
Von:
Elmo84
Datum:
24.09.2021 22:50:20
Views:
206
Rating: Antwort:
  Ja
Thema:
Excel VBA MoveFile - Zielpfad in Unterordner ermitteln

Hallo Leute,

leider hat meine Recherche im Netz nicht mein Problem lösen können.

Ich hoffe ich kann mein Problem hier verständlich darstellen:

Ich habe in einem Ordner einige PDF Dateien. Diese sollen anhand vom Dateinamen ermittelt und verschoben werden.

Der Ziel-Ordner (mit gleichem Namen) befindet sich unter verschiedenen Kunden-Ordner eben in deren Unterordner.

Dieser Code erstellt aber einen neuen Ordner mit eben dem entsprechenden Dateinamen. Der Code soll aber im Unterordner den zugehörigen Ordner finden und genau dort hin verschieben. Ich hoffe Ihr könnt mir helfen.

Enum enumAction
    xlCopy = 0
    xlMove = 1
End Enum

Sub DateienVerteilen(ByVal Quelle As String, _
            Optional ByVal Ziel As String, _
            Optional ByVal Action As enumAction = 0, _
            Optional ByVal Überschreiben As Boolean = False)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strZiel As String
Dim strPfad As String
Dim msg As Byte
Dim bool As Boolean

Set objFSO = CreateObject("Scripting.Filesystemobject")
If Not objFSO.FolderExists(Quelle) Then MsgBox "Der Ordner '" & Quelle & "' existiert nicht !": Exit Sub
If Not objFSO.FolderExists(Ziel) Then
    msg = MsgBox("Der Ordner '" & Ziel & "' existiert nicht - neu anlegen ?", _
                  vbYesNo Or vbCritical, "Meldung")
    If msg = 7 Then Exit Sub Else MkDir Ziel
End If
Set objFolder = objFSO.GetFolder(Quelle)

If Ziel = "" Then Ziel = Quelle
If Right(Quelle, 1) <> "\" Then Quelle = Quelle & "\"
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"

For Each objFile In objFolder.Files
    strZiel = objFSO.GetBaseName(objFile)
    strPfad = Ziel & strZiel
    If Not objFSO.FolderExists(strPfad) Then MkDir strPfad
   
    If Action = 0 Then
        'kopieren der Datei
        bool = Überschreiben
        If objFSO.FileExists(strPfad & "\" & Dir(objFile)) Then
            If Not Überschreiben Then
                msg = MsgBox("Die Datei existiert bereits - Überschreiben ?", _
                              vbYesNo Or vbCritical, "Meldung")
                If msg = 7 Then GoTo WeiterOhneAktion Else bool = True
            End If
        End If
        objFSO.CopyFile objFile, strPfad & "\", bool
    Else
        'verschieben der Datei
        If objFSO.FileExists(strPfad & "\" & Dir(objFile)) Then
            If Überschreiben Then
                Kill strPfad & "\" & Dir(objFile)
            Else
                msg = MsgBox("Die Datei existiert bereits - Überschreiben ?", _
                              vbYesNo Or vbCritical, "Meldung")
                If msg = 7 Then GoTo WeiterOhneAktion
                Kill strPfad & "\" & Dir(objFile)
            End If
        End If
        objFSO.MoveFile objFile, strPfad & "\" & Dir(objFile, vbDirectory)
    End If
WeiterOhneAktion:
Next objFile
End Sub




Sub Machs()
Call DateienVerteilen(Quelle:="C:\Users\XXX\OneDrive\Documents\Projekte\XXXL\Abteilung\Abteilung01\Schäden\Statusblätter\DATA", _
                      Ziel:="C:\Users\XXX\OneDrive\Documents\Projekte\XXX\Abteilung\Abteilung01\Schäden\Versandschäden\Schäden 2021\" & "", _
                      Action:=xlCopy, _
                      Überschreiben:=False)
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Excel VBA MoveFile - Zielpfad in Unterordner ermitteln
24.09.2021 22:50:20 Elmo84
NotSolved
25.09.2021 08:50:48 Gast60693
NotSolved
25.09.2021 13:53:22 Elmo84
NotSolved
26.09.2021 23:34:13 Nobody
NotSolved
27.09.2021 17:33:34 Elmo84
NotSolved
27.09.2021 18:32:49 Gast35658
NotSolved
27.09.2021 18:38:40 Nobody
NotSolved
27.09.2021 19:03:50 Elmo84
NotSolved
27.09.2021 20:00:18 Nobody
NotSolved
28.09.2021 11:54:37 Nobody
NotSolved
28.09.2021 21:03:34 Nobody
NotSolved
03.10.2021 13:16:13 elmo84
NotSolved