Dateiordner nach Dateinamen suchen und öffnen
29.07.2016 12:52:49
Markus
Ich bin seit 2 Tagen dabei eine Excelliste zu basteln über die ich Zip Datein leichter/ schneller finde indem ich nur einen Teil des Namens in ein Feld eintrage und danach mit dem Befehlsbutton Suchen mir öffnen lasse.
Dies funktioniert einwandfrei! - Solange ich einen festen Ordner vorgebe in dem er suchen soll.
Mein Problem: Ich möchte dass er nicht nur den angegebenen Ordner durchforstet sondern auch deren Unterordner.
Gesucht wird nach Produktteilen die in verschiedenen Ordnern abliegen. Um eine Übersicht zu gewährleisten kann ich keinen globalen Ordner, wo alle Produkte drin sind anlegen und 2 mal sollen die Produkte nicht abliegen, somit müssen die Unterordner bestehen bleiben.
Mein Makro:
Sub DateienAuflisten()
Dim strVerzeichnis As String
Dim strTyp As String
Dim strDateiname As String
Dim loZeile As Long
Dim Datei As String
strTyp = "*.zip"
Application.ScreenUpdating = False
strVerzeichnis = "i:\DATEIPFAD\ÜBERORDNER\SPEZIELLER_UNTERORDER\"
strDateiname = Dir(strVerzeichnis & strTyp)
loZeile = 1
Datei = ActiveSheet.Range("F13") 'hier tippe ich die ersten paar Zahlen ein, wie der _
Dateiname anfängt
With ThisWorkbook.Worksheets(7) 'Tabellenblatt 7---- Wird in Finaldatei schon mit Namen _
angesprochen, falls Tabellenblatt mal verschoben wird.
Do While strDateiname ""
If InStr(strDateiname, Datei) > 0 Then .Cells(14, 1) = strDateiname ' Zelle A14, _
_
hier wird der Link zur gefundenen Datei kurz abgespeichert
strDateiname = Dir
'loZeile = loZeile + 1
Loop
End With
ActiveWorkbook.FollowHyperlink strVerzeichnis & ActiveSheet.Range("A14")
Application.ScreenUpdating = True
MsgBox "fertig" 'Hier fange ich das Makro nur kurz ab, damit ich sehe, ob ich eine _
Endlosschleife drin habe.
Range("A14").Select
Selection.ClearContents 'hier lösche ich den kurz abgespeicherten Link wieder raus
End Sub
Ich habe schon versucht einfach nur den Backslash am Ende zu entfernen damit er in die Unterordner geht zum Suchen, was er aber nicht macht und im Internet habe ich bis jetzt keine nützliche Lösung meines Problems gefunden.
Ich hoffe ihr könnt mir weiterhelfen, besten Dank schonmal und ein schönes Wochenende,
Gruß Markus
Anzeige