Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1640to1644
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ordner / Dateien synchronisieren?

Ordner / Dateien synchronisieren?
18.08.2018 12:32:26
Sergej
Hallo liebe Leute,
lässt sich bitte per VBA ein Verzeichnis incl. Unterverzeichnisse abgleichen bzw. synchronisieren? Am Ende müssen die Inhalte vollständig auf beiden Seiten einheitlich sein.
QUELLE = "T:\Projekte\Service\Düsseldorf\2018\Arcaden Düsselorf\"
ZIEL = "S:\Backup\Meine Projekte\Service\Düsseldorf\2018\Arcaden Düsselorf\"
Beste Grüße,
Sergej

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordner / Dateien synchronisieren?
18.08.2018 12:52:50
Nepumuk
Hallo Sergej,
sind die Ordner / Unterordner im Ziel schon alle da oder müssen die gegebenenfalls noch erstellt werden?
Gruß
Nepumuk
AW: Ordner / Dateien synchronisieren?
18.08.2018 14:43:46
Sergej
Hallo Nepumuk,
in der Regel ist das Zielverzeichnis vorhanden.
Schönen Gruß,
Sergej
AW: Ordner / Dateien synchronisieren?
19.08.2018 09:51:44
Nepumuk
Hallo Sergej,
teste mal:
Option Explicit

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

Public Sub Syncronisieren()
    Const QUELLE As String = "T:\Projekte\Service\Düsseldorf\2018\Arcaden Düsseldorf\"
    Const ZIEL As String = "S:\Backup\Meine Projekte\Service\Düsseldorf\2018\Arcaden Düsseldorf\"
    Dim astrFolders() As String, strFilename As String
    Dim ialngFoldes As Long, lngLen As Long
    lngLen = Len(QUELLE) + 1
    astrFolders = GetFolders(QUELLE)
    For ialngFoldes = LBound(astrFolders) To UBound(astrFolders)
        Call MakeSureDirectoryPathExists(ZIEL & Mid$(astrFolders(ialngFoldes), lngLen))
    Next
    For ialngFoldes = LBound(astrFolders) To UBound(astrFolders)
        strFilename = Dir$(astrFolders(ialngFoldes) & "*.*")
        Do Until strFilename = vbNullString
            Call CopyFileA(astrFolders(ialngFoldes) & strFilename, _
                ZIEL & Mid$(astrFolders(ialngFoldes), lngLen) & strFilename, 0)
            strFilename = Dir$
        Loop
    Next
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    strPath = pvstrPath
    Redim astrFolders(0 To 0)
    astrFolders(0) = pvstrPath
    ialngIndex1 = 1
    Do
        strFolder = Dir$(strPath & "*", vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(strPath & strFolder) And vbDirectory Then
                    Redim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function

Gruß
Nepumuk
Anzeige
AW: Ordner / Dateien synchronisieren?
19.08.2018 10:21:16
Sergej
Guten Morgen Nepumuk,
es funktioniert hervorragend. VIELEN DANK!
Schafft man, auf der Zeilseite, die Dateien / Verzeichnisse zu löschen.
Ich muss am Ende beiden Seiten vollständig gleich haben.
Schönen Gruß,
Sergej
AW: Ordner / Dateien synchronisieren?
19.08.2018 10:40:15
Nepumuk
Hallo Sergej,
kein Problem:
Option Explicit

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

Public Sub Syncronisieren()
    Const QUELLE As String = "T:\Projekte\Service\Düsseldorf\2018\Arcaden Düsseldorf\"
    Const ZIEL As String = "S:\Backup\Meine Projekte\Service\Düsseldorf\2018\Arcaden Düsseldorf\"
    Dim astrFolders() As String, strFilename As String
    Dim ialngFoldes As Long, lngLen As Long
    Dim objFileSystemObject As Object
    If Dir$(ZIEL, vbDirectory) <> vbNullString Then
        Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
        Call objFileSystemObject.DeleteFolder(Left$(ZIEL, Len(ZIEL) - 1), True)
        Set objFileSystemObject = Nothing
    End If
    lngLen = Len(QUELLE) + 1
    astrFolders = GetFolders(QUELLE)
    For ialngFoldes = LBound(astrFolders) To UBound(astrFolders)
        Call MakeSureDirectoryPathExists(ZIEL & Mid$(astrFolders(ialngFoldes), lngLen))
    Next
    For ialngFoldes = LBound(astrFolders) To UBound(astrFolders)
        strFilename = Dir$(astrFolders(ialngFoldes) & "*.*")
        Do Until strFilename = vbNullString
            Call CopyFileA(astrFolders(ialngFoldes) & strFilename, _
                ZIEL & Mid$(astrFolders(ialngFoldes), lngLen) & strFilename, 0)
            strFilename = Dir$
        Loop
    Next
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    strPath = pvstrPath
    Redim astrFolders(0 To 0)
    astrFolders(0) = pvstrPath
    ialngIndex1 = 1
    Do
        strFolder = Dir$(strPath & "*", vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(strPath & strFolder) And vbDirectory Then
                    Redim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function

Gruß
Nepumuk
Anzeige
AW: Ordner / Dateien synchronisieren?
19.08.2018 11:19:56
Sergej
Hallo Nepumuk,
VIELEN DANK!
Schönen Gruß,
Sergej
AW: cmd: XCopy (owT)
18.08.2018 16:16:26
Fennek

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige