Excel 2002, per VBA eine PDF-Datei finden

B_W

Ensign
Registriert
Mai 2008
Beiträge
159
Hallo,

folgende Ausgangssituation:

In einer Spalte stehen verschiedene Nummern, z.B.

Q246 = 5411005702
Q247 = 5310004184

Die zu findenden PDF-Dateien heißen wie die Nummern, also z.B. "5411005702.pdf" oder "5310004184.pdf"

Ich weiß aber nicht, wo sich die Dateien befinden, weil die Unterordner leider manchmal verschoben oder umbenannt werden. Nur der übergeordnete Ordner heißt immer gleich, z.B. "Quittungen". Die Tiefe der Unterordnerebenen kann sich leider auch ändern. Die Suche muss also in der gesamten Ordnerstruktur unterhalb von "Quittungen" stattfinden.

Der Name eines Unterordners beinhaltet stets die ersten 4 Stellen einer Nummer, z.B. "Nummernkreis 5411" oder vielleicht auch "BL5310-13 ". Leider gibt es auch hier kein festes Namensschema.

Ich suche eine VBA-Lösung, mit der ich die PDF-Dateien finden kann, also z.B. "Suche die Datei mit dem Namen, der in Q246 steht."

Mit VBA-Lösungen zu Datei-/Ordner-Operationen habe ich kaum Erfahrungen und komme da einfach nicht weiter. Wie könnte ein Lösungsansatz aussehen?

Vielen Dank!

BW
 
Ein Lösungsansatz auf die Schnelle:

Du die gesamte Ordnerstruktur ab Quittungen, überprüfst in jedem Ordner die pdf-Dateien ob sie die 4er-Zahlenkombination im Dateinamen enthalten.

Als Pseudocode:
Unterordner ... U(n)
Pdf-Dateien ... P
Gefundene Dateien ... G

G = null
search(Ordner n, String suche){
falls(U(n) is not null) {
für alle m aus U(n){
Ordner(m,suche)
}​
}​
sonst{
für alle p aus P{
falls(p.name.contains(suche)){
G.add(p)
}​
}​
}​
 
Zuletzt bearbeitet:
Als Vorgehen sehe ich hier ein Rekursives. Ab dem Ordner "Quittungen" alle Dateien auf den gesuchten Dateinamen prüfen, wenn vorhanden merken. Sind Unterordner enthalten, die Suche mit dem Pfad zum Unterordner als neuer Startpfad fortsetzen. Ich habe mal eine Lösung in einen Spoiler gepackt, bei Interesse erstmal selbst etwas zu probieren.
Hier die Doku von Microsoft zum FileSystemObject: http://msdn.microsoft.com/en-us/library/hww8txat%28v=vs.84%29.aspx
Man kann das ganze auch so erweitern, dass weitere Infos wie Änderungsdatum und Größe zu den Dateien mit übergeben werden. Falls es mehrere Versionen eines Dokumentes geben kann.
Code:
Public Function startSearch(ByVal startPath As String, ByVal fileName As String) As Variant
    Dim foundPathes As Variant
    foundPathes = Array()
    searchFolders startPath, fileName, foundPathes
    startSearch = foundPathes
End Function
Private Sub searchFolders(ByVal folderPath As String, ByVal fileName As String, ByRef pathesList As Variant)
    
    Dim objFSO As Object, objWorkFolder As Object, objSubFolders As Object, objSubFolder As Object, objFiles As Object, objFile As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objWorkFolder = objFSO.GetFolder(folderPath)
    Set objFiles = objWorkFolder.Files
    Set objSubFolders = objWorkFolder.SubFolders
    
    For Each objFile In objFiles
        If objFile.Name = fileName Then
            ReDim Preserve pathesList(UBound(pathesList) + 1)
            pathesList(UBound(pathesList)) = objFile.parentfolder
        End If
    Next
    For Each objSubFolder In objSubFolders
        searchFolders objSubFolder.Path, fileName, pathesList
    Next
    
    Set objFSO = Nothing
    Set objWorkFolder = Nothing
    Set objSubFolder = Nothing
    Set objSubFolders = Nothing
    Set objFile = Nothing
    Set objFiles = Nothing
End Sub
Aufruf: x = startSearch("D:\Quittungen", "10001234.pdf")

Ist zwar mit Excel 2010 getestet, sollte aber auch in 2002 laufen.

Da hier keine Vorhersage gemacht werden kann, auf welcher Ebene sich eine Datei befindet, nützt die Einschränkung nicht viel, dass der Elternordner der gesuchten Datei mit den gleichen Ziffern beginnt. Die gesuchte Datei kann ja beliebig irgendwo geschachtelt sein. Wenn die Suche zu lange dauert (was bei rekursiver Suche in großen Ordnerstrukturen schnell passieren kann), sollten Regeln für die Dateistruktur aufgestellt werden. Z.B. Ordner zu Nummernkreisen immer nur auf Ebene 1 unter "Quittungen". Sonst kann man nicht wirklich viel schneller werden.
Noch ein Hinweis: Derjenige der das Makro ausführt, sollte auch die Berechtigungen haben alle Ordner und Dateien lesen zu können. Fehlen die entsprechenden Rechte bei einem Objekt, landet das Makro mit einem Laufzeitfehler auf den Brettern.
 
Zuletzt bearbeitet:
Hallo zusammen,

in der Zwischenzeit habe ich eine funktionierende kleine Lösung erstellt:

Code:
Sub Archiv()
Dim path As String
    path = "D:\Quittungen\"
    With Application.FileSearch
      .NewSearch
      .LookIn = path
      .SearchSubFolders = True
      .filename = ActiveCell.Value & ".pdf"
      If .Execute() > 0 Then
        ActiveWorkbook.FollowHyperlink .FoundFiles(1)
      Else
        MsgBox ("Datei nicht vorhanden.")
      End If
    End With
End Sub

... und das PDF wird geöffnet, so wie es sein soll.

Leider wird das alte Excel 2002 hier bald abgelöst und Application.FileSearch funktioniert dann bekanntlich nicht mehr. Deshalb habe ich versucht, den Code von Spike S. zu nutzen, komme aber leider nicht voran. Auch andere Beispiele im Netz kann ich an meine obige Lösung nicht anpassen, ich krieg's einfach nicht hin.

Vielleicht kann mir da nochmal jemand helfen, wäre nett :-)

BW
 
Zurück
Oben