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