Access-o-Mania

Access-Forum (Deutsch/German) => Access Programmierung => Thema gestartet von: Gockel67 am Oktober 18, 2024, 16:17:46

Titel: Kopieren von Bildern
Beitrag von: Gockel67 am Oktober 18, 2024, 16:17:46
Moin Gemeinde,

im Forum www.ms-office-forum.net bekam ich Hilfe um Bilddateien zu sichern. Bevor ich aber die letzte Antowrt einsehen konnte war das Forum leider zu.

Es geht um folgendes:

Ich möchte aus einer Access-Anwendung Bilder von einem Ort zu einem anderen kopieren. Dabei werden nur die Bilder kopiert die im Zielverzeichnis noch nicht vorhanden sind. Das funktioniert auch super. Jetzt soll die Routine noch um Unterverzeichnise erweiter werden. Und da scheitern leider meine Kenntnisse.

Könnte mir hier einer weiterhelfen?

Um folgenden Code geht es:

Sub CopyFiles()
  Dim fso As Object           ' Scripting.FileSystemObject
  Dim fls As Object           ' Scripting.Files
  Dim fil As Object           ' Scripting.File
 
  pfadquelle = CurrentProject.path & "\Bilder\"
  pfadziel = Ziel & "Bilder\"
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set fls = fso.GetFolder(pfadquelle).Files   ' < anpassen
 
  Dim f As Folder
  Set f = fso.GetFolder(pfadquelle)
 
  On Error GoTo err_handler
 
  For Each fil In fls
  Counter = Counter + 1
    ProgressBar.Width = PBB / (f.Files.Count) * Counter
    lblProzent.Caption = Round(100 / (f.Files.Count) * Counter, 0) & " %"

Select Case fso.GetExtensionName(fil.Name)
      Case "jpg", "jpeg", "png", "bmp", "tif"
      fil.Copy pfadziel, False         ' < anpassen
 Case Else
        ' Nothing todo
    End Select

  Next
 
err_exit:
  ' Cleanup
  Set fil = Nothing
  Set fls = Nothing
  Set fso = Nothing
  Exit Sub

err_handler:
  If Err.Number = 58 Then           ' Datei existiert bereits!
    ' Nothing todo
    Resume Next
  Else
    Debug.Print "Error:"; Err.Number, Err.Description
  End If
 
  Resume err_exit
 
End Sub

Wünsche allen ein schönes Wochenende
Jörg
Titel: Re: Kopieren von Bildern
Beitrag von: Hondo am Oktober 18, 2024, 17:02:05
Hallo,
versuch mal folgendes:
Sub CopyFiles()
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  fso.movefolder pfadquelle, pfadziel
  ...
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Oktober 18, 2024, 17:41:57
Danke. Werde ich mir morgen mal anschauen.
P.S. Habe gerade nach MoveFolder geschaut. Die Bilder sollen nur kopiert aber nicht verschoben werden.
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Oktober 18, 2024, 20:52:14
Hey, habe Dir mal eine kleine Demo angehangen.

Du kannst das Quellverzeichnis wählen und das Zielverzeichnis. Die Unterverzeichnisse werden mit kopiert und angelegt. Vorhandene Datei werden übergangen und im Zielverzeichnis wird noch ein Logfile angelegt.
Vielleicht ist es ja sowas wie Du suchst.

Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Knobbi38 am Oktober 19, 2024, 12:31:20
Hallo Jörg,

hier zwei Module, die dir bei deiner Aufgabe hilfreich sein könnten. Aufrufsyntax und eine kleine Hilfe im Modul.

Im Prinzip erstellst du eine Liste der zu kopierenden Dateien und arbeitest dies dann einfach ab. Mit FileExists() prüfst du, ob die Datei vorhanden ist und reagierst entsprechend darauf.
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Oktober 19, 2024, 12:39:49
Hallo Ulli,

ich habe das ja so in der Demo gemacht.

Hier mal der Code aus dem Modul

Option Compare Database
Option Explicit

Sub CopyImageFiles()
    Dim fDialog As Object
    Dim sourceFolder As String
    Dim targetFolder As String
    Dim logFilePath As String
    Dim logFile As Integer
    Dim fileSystem As Object

   
    Set fDialog = CreateObject("Shell.Application").BrowseForFolder(0, "Wähle das Quellverzeichnis aus:", 0)

    If Not fDialog Is Nothing Then
        sourceFolder = fDialog.Items().Item().Path

       
        Set fDialog = CreateObject("Shell.Application").BrowseForFolder(0, "Wähle das Zielverzeichnis aus:", 0)

        If Not fDialog Is Nothing Then
            targetFolder = fDialog.Items().Item().Path

           
            logFilePath = targetFolder & "\Logfile.txt"
            logFile = FreeFile

           
            Set fileSystem = CreateObject("Scripting.FileSystemObject")

           
            Open logFilePath For Output As #logFile

           
            Call CopyFiles(fileSystem, sourceFolder, targetFolder, logFile)

           
            Close #logFile

            MsgBox "Kopieren abgeschlossen! Logfile wurde erstellt: " & logFilePath

        Else
            MsgBox "Zielverzeichnis wurde nicht ausgewählt."
        End If

    Else
        MsgBox "Quellverzeichnis wurde nicht ausgewählt."
    End If

End Sub

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

   
    Set folderObj = fileSystem.GetFolder(sourceFolder)

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

   
    For Each fileObj In folderObj.Files

        '''''''''''' Hier die Dateitypen festlegen ''''''''''''''''''
       
        If LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*bmp" Or _
           LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*jpg" Or _
           LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*jpeg" Or _
           LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*png" Or _
           LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*gif" Then

            On Error Resume Next

           
            newTargetFolder = targetFolder & Mid(fileObj.Path, Len(sourceFolder) + 1)

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

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

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

            Else
                Print #logFile, "Übergangen: " & newTargetFolder & " (bereits vorhanden)"
            End If

            On Error GoTo 0

        End If

    Next fileObj

   
    For Each subfolderObj In folderObj.SubFolders

        Call CopyFiles(fileSystem, subfolderObj.Path, targetFolder & Mid(subfolderObj.Path, Len(sourceFolder) + 1), logFile)

    Next subfolderObj

End Sub


Gruß
Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Knobbi38 am Oktober 19, 2024, 13:24:08
Hallo Holger,

natürlich kann man das so machen und individuell eine rekursive Routine zu schreiben.

Mit der Modulfunktion geht es auch darum, auf einen fertige, getestete und optimierte Funktion zurückzugreifen. Warum das Rad immer wieder neu erfinden? So werden z.B. die gesuchten Dateimuster und ob Unterordner durchsucht werden sollen als Argumente übergeben und man braucht sich um nichts mehr kümmern.

Für die Ordnerabfrage würde ich allerdings einfach auf das Filedialog-Objekt zurückgreifen, anstatt die Shell-Automaton zu bemühen, aber das ist Geschmackssache. Genauso ist es mit dem Logfile. Wenn schon das FSO bemüht wird, kann man das dafür auch gleich mit verwenden.

Kleine Anmerkung am Rande:
Wenn hierbei verschachtelte Unterordner angelegt werden müssen,  könnte man dafür die API Funktion "SHCreateDirectoryEx" verwenden.


 


Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Oktober 19, 2024, 13:28:47
Hallo Ulli,

Du hast natürlich recht, aber ich habe das schonmal so für andere Dateitypen machen müssen mit dem LogFile daher kam das einfach mal so.

Gruß und ein schönes Wochenende
Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Knobbi38 am Oktober 19, 2024, 13:37:34
@Debus

Ja sicher, wenn man so etwas schon in der Schublade hat, warum nicht?
Die Details sind sicherlich für den einen oder anderen sehr Hilfreich, z.B. BrowseForFolder für die Office-Anwendungen, wo es keinen Filedialog gibt.
Auf diese Weise kann man sich auch mal schnell den Aufbau einer rekursiven Funktion oder das Anlegen von verschachtelten Ordern anschauen, um etwas zu lernen.

Grüße
Ulrich
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Oktober 20, 2024, 10:08:03
Danke an Holger und Ulrich. Ihr seid meine Helden. Das File von Holger war genau das was ich gesucht habe. Jetzt kann ich meine zwei Datenbanken endlich um eine Datensicherung erweitern.
Wünsche allen einen schönen und geruhsamen Sonntag.
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Oktober 22, 2024, 16:35:17
Auf Wunsch von Gockel nochmal angepasst:

Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Oktober 23, 2024, 07:20:45
Hallo Holger,
einen ganz dicken Dank an dich und deine Arbeit. Jetzt funktioniert alles so wie es soll.
Werde dich lobend in mein Nachtgebet mit einschliessen  :D
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Oktober 23, 2024, 20:29:43
Auf Wunsch ohne ocx von MS welches man ja nicht wirklich anpassen kann also Farbe etc.

Hier habe ich es mit zwei Rechtecken gemacht, wo man ja das Design anpassen kann.

Holger

Frage @ alle kann man bei den privaten Messages auch Dateianlangen versenden?  Habe ich nicht gefunden

Titel: Re: Kopieren von Bildern
Beitrag von: Knobbi38 am Oktober 23, 2024, 23:57:47
Zitat von: Debus am Oktober 23, 2024, 20:29:43Frage @ alle kann man bei den privaten Messages auch Dateianlangen versenden?  Habe ich nicht gefunden
Nein, meines Wissens ist das nicht vorgesehen.
Titel: Re: Kopieren von Bildern
Beitrag von: Köbi am Oktober 24, 2024, 02:01:36
Hallo Holger
Vielen Dank für deine DB zum Kopieren von Dateien von einem Verzeichnis zum andern.
Dazu habe ich noch folgende Fragen und Anmerkungen.

Diese Codezeile
Me.ProgressBar.Value = 0 in der Sub CopyImageFiles() verursacht beim Debuggen einen Fehler. Kann meiner Meinung nach weggelassen werden. Dann funktioniert die Progressbar trotzdem.

2.   Frage: Weshalb zeigt die Progressbar nach einer längeren Kopiererein höchstens 99% an, und nie 100%?
3.   Logfile. In der früheren Version wurde ein Logfile erstellt. Das ist jetzt auch noch so, aber die Datei «logfile.txt» bleibt leer. Dafür wird der Ablauf im Formular angezeigt. Das ist nett, aber nach dem Schliessen des Formulars ist der Verlauf weg. Ich meine, das logfile sollte weiterhin als Datei vorhanden sein. Als Beleg dafür, wer und wann jemand Dateien kopiert hat.
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Oktober 24, 2024, 07:10:18
Moin Köbi,
zu Punkt 3. Einfach alle Bilder.zip laden und so zusammenschneiden wie du es brauchst. Holger hat für mich mehrere Erweiterungen gemacht. Deshalb kann auch die Zeile mit der ProgressBar raus. Die ist noch von mir.

@holger: Wahnsinn was du dir für andere für eine Arbeit machst. Ich hatte doch nur nachgefragt ob es das OCX auch in schön gibt  :D
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Oktober 24, 2024, 07:11:44
Moin Köbi,
zu Punkt 3. Einfach alle Bilder.zip laden und so zusammenschneiden wie du es brauchst. Holger hat für mich mehrere Erweiterungen gemacht. Deshalb kann auch die Zeile mit der ProgressBar raus. Die ist noch von mir.

@holger: Wahnsinn was du dir für andere für eine Arbeit machst. Ich hatte doch nur nachgefragt ob es das OCX auch in schön gibt  :D

P.S. Sorry für den Doppelpost. Mein Rechner hat gesponnen.
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Oktober 24, 2024, 07:21:23
Moin Holger,
jetzt sitz ich hier vor dem Rechner und komme aus dem Staunen nicht mehr raus. Genau so hatte ich das zuerst gelöst als ich nur einen Ordner kopieren konnte. Nach deiner Änderung um mehrere Ordner zu kopieren funktionierte das nicht mehr und ich hatte es weggelassen.

Deine Lösung mit den Rechtecken kommt mir sehr entgegen da die ProgressBar auf einem anderen Rechner nicht funktioniert hat (ist halt ein Spezialfall mit einer Portable Virtualbox und Windows10 wo nur Die Access-Runtime drauf läuft).

Ich weiß gar nicht was ich sagen soll. Danke reicht für die Arbeit die du dir für andere machst definitiv nicht aus.

Jetzt funktioniert meine Datensicherung universell für alle meine Datenbanken. Ich beschäftige mich mit Access halt immer nur so weit wie ich es für meine eigentlichen Hobbys benötige. Ohne deine Hilfe hätte ich das niemals so hinbekommen.

Ganz dicken Dank an dich.
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Oktober 24, 2024, 15:31:02
Hallo Köbi

1. Die Zeile hatte ich übersehen, die kam von Gockel -  sorry ist natürlich raus
2. die 100% werden bei mir angezeigt siehe Bild
3. Das Logfile habe ich nun auch wieder mit drin und am Ende noch als Statistik erweitert. Der Dateiname beinhalten nun auch noch den Windows User sowie Datum und Uhrzeit.

Gruß
Holger



Titel: Kopieren von Bildern
Beitrag von: Köbi am Oktober 24, 2024, 19:30:26
Hallo Holger
Vielen Dank für die neueste Version der DB. Ich kann mich dem Lob von Gockel nur anschliessen. Auch ich werde dich in meinem Nachtgebet einschliessen. Zusätzlich schenke ich dir noch 4 Punkte in Flensburg. 8)

Noch ein paar Bemerkungen und Anliegen:

Progressbar: Ich habe 1380 Dateien kopiert, bin damit nur auf 99% gekommen. Nachdem ich noch etwa 2000 mp3-Dateien zum kopieren hinzugefügt habe, kommt auch mein PC auf 100%.

Logfile: Wenn ein Verzeichnis mit Unterverzeichnissen kopiert wird, werden pro Verzeichnis/Unterverzeichnis die Anzahl der kopierten Dateien und die Statistik angezeigt. Eine Statistik über alle kopierten Dateien fehlt. Ist aber nicht schlimm, man kann sie ja mit dem Rechner zusammenzählen. Wäre aber ein nice-to-have.

ALLE Dateien kopieren. Ich möchte alle Dateitypen kopieren, weiss aber nicht wie das geht. So jedenfalls nicht
'  #### Alle Dateien kopieren:
 '        If LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*.*" Then

Mach dir jetzt aber keinen Kopf. Ich erwarte nicht, dass dich bemühst, meine Anliegen zu lösen. Eigentlich bin ich ja schon so zufrieden.
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Oktober 24, 2024, 22:32:07
Habe es dann nochmal umgebaut. So ist es nun auch noch flexibel. Erweitern ist so ganz einfach.
Im Logfile das Addieren kann man auch noch machen.

Habe das ganze dann nochmal angehangen
Titel: Kopieren von Bildern
Beitrag von: Köbi am Oktober 25, 2024, 17:55:51
Hallo Holger
Vielen Dank für deine Arbeit. Ich habe noch folgende Änderungen und Ergänzungen vorgenommen:
Private Function ShouldCopyFile(fileSystem As Object, fileObj As Object)
   
   Select Case Me.cboDateiTyp.Value
       Case "Bilder"
           ShouldCopyFile = LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*bmp" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*jpg" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*jpeg" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*png" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*gif" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*Tiff" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*raw"
                                   
       Case "Alle Dateien"
           ShouldCopyFile = True
           
       Case "Office Dateien"    'Word, Excel und Powerpoint
           ShouldCopyFile = LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*do*" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*xl*" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*ppt*" Or "*po*"     'Powerpoint
                           
       Case "Musik Dateien"
           ShouldCopyFile = LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*mp3" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*wav" Or _
                            LCase(fileSystem.GetExtensionName(fileObj.Name)) Like "*wma"

       Case Else
           ShouldCopyFile = False
   End Select
End Function

Die Bilderauswahl habe ich noch um die Dateiendungen Tiff und raw erweitert. Das ist eher nebensächlich.

Wichtiger sind die Änderungen bei den Office Dateien. Hier habe ich die Dateiendungen gekürzt und mit * ergänzt. Damit werden alle Word-Dateien, alle Excel-Dateien und alle Powerpoint-Dateien beim Kopiervorgang mitgenommen. Also sowohl doc, docx, dot, dotx, dotm, oder xls und xlsx mit Konsorten.

Die Musik Dateien habe ich nur eingefügt, weil ich sie gerade brauche.
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Januar 27, 2025, 11:34:57
Gibt es eigentlich die Möglichkeit Ordner vom kopieren auszuschliessen?
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Januar 27, 2025, 12:50:02
Meinst Du bestimmte Ordner also immer die selben oder was genau?

Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Knobbi38 am Januar 27, 2025, 12:53:47
Und wie erkennst du die Ordner, welche nicht kopiert werden sollen?
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Januar 27, 2025, 12:57:49
Hallo Ulli,

daher ja meine Frage ob er bestimmte Ordner meint oder was genau dabei gemeint ist. Wenn er einige statische Ordner ausschließen will, wird es gehen. Aber ansonsten fragen wir mal Aladin :=)))

Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Knobbi38 am Januar 27, 2025, 13:15:46
@Debus

Das würde schon it etwas Aufwand gehen, indem man z.B. eine Listbox mit Multiselect verwendet und alle nicht zu kopierenden Ordner auswählt. Ohne Interaktion aber ist alles nur statisch.
Warum sollten nochmal überhaupt Dateien/Ordner kopiert werden?

Gruß Ulrich


Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Januar 27, 2025, 13:47:06
Hallo Ulli,

ZitatWarum sollten nochmal überhaupt Dateien/Ordner kopiert werden?

Wenn ich mich richtig erinnere sollten einfach nur Bilder von A nach B kopiert werden und wenn schon vorhanden übergangen werden. Hätte man sicherlich auch mit Windows Boardmittel oder TotalCommander oder FreeCommander etc einfach hinbekommen können.

Und ja mit einer Auswahlmöglichkeit wie ListBox würde man es hinbekommen. Nur ist ja eigentlich alles schon vorhanden.

Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Gockel67 am Januar 27, 2025, 14:10:40
Es geht nur um einen bestimmten Ordner. Immer der selbe. Aber wenn es zuviel Aufwand ist verschieb ich den ganz einfach woanders hin
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Januar 27, 2025, 14:42:48
Hey, pass die Datei von mir mal einfach wie folgt an:

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

    Set folderObj = fileSystem.GetFolder(sourceFolder)

   
    If ShouldSkipFolder(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 ShouldSkipFolder(folderPath As String) As Boolean
    Dim skipFolders As Variant
    skipFolders = Array("C:\Pfad\Zu\Überspringen", "C:\Ein\Anderer\Ordner") ' Fügen hier die zu überspringenden Ordner hinzu
   
    Dim folder As Variant
    For Each folder In skipFolders
        If LCase(folderPath) = LCase(folder) Then
            ShouldSkipFolder = True
            Exit Function
        End If
    Next folder
   
    ShouldSkipFolder = False ' nicht überspringen
End Function



Der Code ist allerdings ungetestet!

Du kannst natürlich das Array direkt im Code befüllen oder wie Ulli geschrieben hat es über eine Listbox mit Multiselect befüllen, aber das ist ein anderes Thema

Gruß
Holger
Titel: Re: Kopieren von Bildern
Beitrag von: Knobbi38 am Januar 27, 2025, 15:33:50
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
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Januar 27, 2025, 15:41:26
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
Titel: Re: Kopieren von Bildern
Beitrag von: Debus am Januar 27, 2025, 15:56:47
Ja Ulli hat wie immer Recht  8)  ;)  :)

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:

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