Sub-Ordner int. bei meinem Code?

Hallo zusammen,
Bei euch sind die Experten :-). Ich hoffe diese Mal ist mein Problem nicht mehr so kompliziert und jemand kann mir eine Lösung präsentieren :-)
Grundsätzlich habe ich eine Zelle, welche die Basis ist zur Suche in einem Ordner mit Unterordner.
Die Zelle generiert einen Code, welcher dem Namen einer bestimmten PDF-Datei entspricht.
Nun möchte ich, dass mir durch drücken auf den Knopf, das Excel die PDF`s auflistet, welche dem Code (Dateinamen) entsprechen. Es sollen möglichst alle PDF`s gelistet werden, welche dem Code entsprechen. z.B. in der Zelle steht 101-20-303-0-01, nun sollen auch dejenigen gelistet werden welche so aussehen könnten:101-20-303-0-01A, 101-20-303-0-0134.
Diese PDF sollen als Hyperlink erscheinen. In der Bsp.-Datei findet ihr mein Code.
https://www.herber.de/bbs/user/114940.zip
Hoffentlich kann mir jemand helfen......
Viele Grüsse Tobi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo!
Ist das nicht auch Dein Faden: https://www.herber.de/forum/messages/1568951.html
Wenn der noch offen ist, solltest Du dort bleiben - bzw. ihn jetzt schließen, nachdem ich Dir hier geantwortet habe.
Teste bitte folgenden Code:

Sub a()
'Directory Loop by Cor_Blimey
Const PFAD$ = "\\HV01\FTP Nibe\03 PM\03 Standard_Schema\"
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("WP-System Modul")
Dim ChkCode As Range, Hl As Range, fso, oFolder, oSubfolder, oFile
Dim queue As Collection
Set ChkCode = Ws.Range("I9")
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(PFAD)
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder
Next oSubfolder
For Each oFile In oFolder.Files
If Left(oFile.Name, Len(ChkCode.Text)) = ChkCode.Text Then
With Ws
Set Hl = .Cells(.Rows.Count, "V").End(xlUp).Offset(1, 0)
With Hl
.Hyperlinks.Add anchor:=Hl, Address:=PFAD & oFile.Name
End With
End With
End If
Next oFile
Loop
End Sub

Den durchsuchten Hauptpfad kannst/musst Du im Code anpassen (bei PFAD), dieser wird, inkl. Sub-Verzeichnissen, durchgegangen und jeder Dateiname mit dem Text in Zelle I9 auf dem Blatt "WP-System Modul" verglichen - entsprechen die ersten x Zeichen des Dateinamens dem Text in I9, wird in Spalte V fortlaufend (= zeilenweise) ein Hyperlink auf die Datei angelegt; wobei x hierbei für die länge des Textes in I9 steht.
Gib Bescheid, ob Du damit zurechtkommst.
LG
Michael

Sub a() 'Directory Loop by Cor_Blimey Const PFAD$ = "\\HV01\FTP Nibe\03 PM\03 Standard_Schema\" Dim Wb As Workbook: Set Wb = ThisWorkbook Dim Ws As Worksheet: Set Ws = Wb.Worksheets("WP-System Modul") Dim ChkCode As Range, Hl As Range, fso, oFolder, oSubfolder, oFile Dim queue As Collection Set ChkCode = Ws.Range("I9") Set fso = CreateObject("Scripting.FileSystemObject") Set queue = New Collection queue.Add fso.GetFolder(PFAD) Do While queue.Count > 0 Set oFolder = queue(1) queue.Remove 1 For Each oSubfolder In oFolder.SubFolders queue.Add oSubfolder Next oSubfolder For Each oFile In oFolder.Files If Left(oFile.Name, Len(ChkCode.Text)) = ChkCode.Text Then With Ws Set Hl = .Cells(.Rows.Count, "V").End(xlUp).Offset(1, 0) With Hl .Hyperlinks.Add anchor:=Hl, Address:=oFolder.Path & oFile.Name End With End With End If Next oFile Loop End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread