Kopieren von Bildern

[knobbi38]

Hallo Holger,

anstatt jetzt das in einer Schleife abzuarbeiten und die Ordnernamen fest im Code zu haben, mal ein anderer Vorschlag:

Ich könnte mir auch vorstellen, die Ordner aus einer Tabelle in ein Dictionary zu laden und dann nur auf exists zu prüfen, so ganz ohne Schleife und hart kodierte Ordner im Sourcecode.

Nur mal so ...

Grüße Ulrich

[Debus]

Hallo Ulli,

ja sicherlich die eigentlich bessere Idee aber da es ja nur ein Ordner sein soll, der auch noch dazu statisch ist war das mal so auf die schnelle.


Holger

[Debus]

Ja Ulli hat wie immer Recht     

Ich habe mal versucht das in der kürze umzusetzten.

1. Erstelle eine Tabelle mit den zu überspringenden Ordner. Bei mir heißt diese tblSkipFolders.
Es muss das Feld FolderPath vorhanden sein, worin die Pfade gespeichert werden.

2. Es wird nun ein Dictionary verwendet, welches die Pfade aus der Tabelle liest.

3. In der Function LoadSkipfolders wird nun die Tabelle geöffnet und die Pfade ins Dictionray geladen. Hier wird jeder Pfad in kleinbuchstaben umgewandelt, damit es unabhängiger wird von Groß-/Kleinschreibung.   -  Also egal wie Du es in der Tabelle aufführst.

4. Bei der Sub CopyFiles wird nun statt der Schleife folgendes  'skipFolders.Exists(LCase(sourceFolder))'  verwendet um zu überprüfen  ob der gerade aktuelle Ordner übersprungen werden soll.

Hier noch der Code:

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit



Sub CopyFiles(fileSystem As Object, sourceFolder As String, targetFolder As String, logFile As Integer)
    Dim folderObj As Object
    Dim fileObj As Object
    Dim subfolderObj As Object
    Dim newTargetFolder As String
    Dim totalFiles As Long
    Dim copiedFiles As Long
    Dim skippedFiles As Long
    Dim skipFolders As Object

    Set skipFolders = LoadSkipFolders()
    Set folderObj = fileSystem.GetFolder(sourceFolder)

   
    If skipFolders.Exists(LCase(sourceFolder)) Then
        Print #logFile, "Übersprungen: " & sourceFolder & " (übersprungener Ordner)"
        Exit Sub
    End If

    totalFiles = CountFiles(folderObj)

    If Not fileSystem.FolderExists(targetFolder) Then
        fileSystem.CreateFolder targetFolder
    End If

    For Each fileObj In folderObj.Files
        On Error Resume Next

        If ShouldCopyFile(fileSystem, fileObj) Then
            newTargetFolder = targetFolder & Mid(fileObj.Path, Len(sourceFolder) + 1)

            If Not fileSystem.FolderExists(fileSystem.GetParentFolderName(newTargetFolder)) Then _
                fileSystem.CreateFolder fileSystem.GetParentFolderName(newTargetFolder)

            If Not fileSystem.FileExists(newTargetFolder) Then
                fileSystem.CopyFile fileObj.Path, newTargetFolder

               
                Print #logFile, "Kopiert: " & fileObj.Path & " nach " & newTargetFolder

                copiedFiles = copiedFiles + 1
            Else
                Print #logFile, "Übersprungen: " & newTargetFolder & " (bereits vorhanden)"
                skippedFiles = skippedFiles + 1
            End If

            UpdateProgressBar copiedFiles, totalFiles
        End If

        On Error GoTo 0

        DoEvents
    Next fileObj

    For Each subfolderObj In folderObj.SubFolders
        Call CopyFiles(fileSystem, subfolderObj.Path, targetFolder & Mid(subfolderObj.Path, Len(sourceFolder) + 1), logFile)
    Next subfolderObj

   
    Print #logFile, vbCrLf & "Zielverzeichnis: " & targetFolder
    Print #logFile, "Gesamtzahl der kopierten Dateien im Zielverzeichnis: " & copiedFiles
    Print #logFile, "Gesamtzahl der übersprungenen Dateien im Zielverzeichnis: " & skippedFiles

End Sub

Function LoadSkipFolders() As Object
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim dict As Object
   
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT FolderPath FROM tblSkipFolders")
   
    Set dict = CreateObject("Scripting.Dictionary")

    Do While Not rs.EOF
        dict.Add LCase(rs!FolderPath), True
        rs.MoveNext
    Loop
   
    rs.Close
    Set LoadSkipFolders = dict
End Function



Private Sub cmdkopieren_Click()
   CopyImageFiles
End Sub

Private Sub Form_Load()
   Me.txtLog = ""
End Sub

Ich hoffe das hilft.

Danke Ulli aber so ist es definitiv besser   


Holger