Neuigkeiten:

Ist euer Problem gelöst, dann bitte den Knopf "Thema gelöst" drücken!

Mobiles Hauptmenü

(Unter)Ordner durchsuchen und Datei kopieren

Begonnen von Mounzer, April 11, 2023, 15:29:26

⏪ vorheriges - nächstes ⏩

Mounzer

Hallo liebe Community,

vorab, ich bin nicht 100% fit in Access-VBA, weshalb ich auch an dieser Stelle Hilfe benötige.
Ich habe folgenden Code und verstehe nicht, weshalb die PDF-Datei nicht gefunden wird, obwohl diese existiert:  :(


Private Sub cmdProtokollCopy_Click()
    Dim quellpfad, zielPfad, dateiname, dateinameAlt As String
    Dim fso         As Object
    Dim quelle      As Object
    Dim ziel        As Object
    Dim ordner      As Object
    Dim datei       As Object
   
    quellpfad = "N:\Daten\FB4\Produkte\404\"        'Hier den Pfad zum Quellverzeichnis eintragen
    'PDF-Dateiname aus dem Textfeld lesen
    If IsNull(Me!txtPDFName) And IsNull(Me!txtPDFNameAlt) Then
        MsgBox "Geben Sie bitte einen PDF-Dateinamen ein.", vbCritical, "Fehler"
    Else
        dateiname = ""
    If Not IsNull(Me!txtPDFName) Then
        dateiname = Me!txtPDFName.Value & ".pdf"

    End If
        dateinameAlt = ""
        If Not IsNull(Me!txtPDFNameAlt) Then
            dateinameAlt = Me!txtPDFNameAlt.Value & ".pdf"
        End If
        'Zielverzeichnis aus dem Textfeld lesen
        If IsNull(Me!txtFilmNr) Then
            MsgBox "Geben Sie bitte einen Zielordner ein.", vbCritical, "Fehler"
        Else
            zielPfad = "S:\outwowg\Messprotokoll\Film\" & Me!txtFilmNr.Value & "\"        'Hier den Pfad zum Zielverzeichnis mit dem Text aus dem Textfeld erstellen
            Set fso = CreateObject("Scripting.FileSystemObject")
           
            'Alle Ordner im Quellverzeichnis durchsuchen
            For Each ordner In fso.GetFolder(quellpfad).SubFolders
                For Each datei In ordner.Files
                    'Wenn die PDF-Datei gefunden wird, fragen, ob sie kopiert werden soll
                    If datei.Name = dateiname Or datei.Name = dateinameAlt Then
                        If MsgBox("Möchten Sie die Datei        '" & datei.Name & "' kopieren?", vbQuestion + vbYesNo, "Datei gefunden") = vbYes Then
                            Set quelle = fso.GetFile(datei.Path)
                            Set ziel = fso.GetFolder(zielPfad)
                            ' Datei kopieren
                            quelle.Copy ziel & "\" & datei.Name
                            MsgBox "Die Datei wurde erfolgreich kopiert!", vbInformation, "Datei kopiert"
                            ' Schaltflächen aktualisieren
                            Me!cmdProtokollCopy.Enabled = False
                            Me!cmdSpeichern.Enabled = True
'                            Me.RecalcLayout
                            ' Formular aktualisieren
                            Me.Requery
                            ' Frage stellen, ob das Zielverzeichnis geöffnet werden soll
                            If MsgBox("Möchten Sie das Zielverzeichnis öffnen?", vbQuestion + vbYesNo, "Datei kopiert") = vbYes Then
                                Shell "explorer /select," & zielPfad, vbNormalFocus
                            End If
                            Exit Sub
                        End If
                    End If
                Next datei
            Next ordner
           
            'Wenn die Datei nicht gefunden wurde
            MsgBox "Die Datei konnte nicht gefunden werden.", vbCritical, "Fehler"
        End If
    End If
   
End Sub

Debus