Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1840to1844
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Excel 2013 Unterordner durchsuchenn

Excel 2013 Unterordner durchsuchenn
12.08.2021 13:40:48
Manfred
Hallo zusammen,
ich habe das Makro so angepasst dass es mir die xlsx-Dateien aus dem Ordner öffnet.
In Spalte A habe ich 2000 Einträge drin wo nur eine 5-stellige Zahl steht. Ich markiere eine und die xlsx-Datei wird geöffnet.
Der Dateiname ist z.B.: 12345_Dateiname_Kommen_Weiteres_Geschehen.xlsx

Sub Antrag_suche()
Dim suche As String
Dim Dateiname
strpfad = "P:\01_Antraege\"    'das ist der Ordner
suche = ActiveCell.Value
Dateiname = Dir((strpfad & suche & "*" & ".xlsx"))  'Der Dateiname suchen
If Dateiname  "" Then
ActiveWorkbook.FollowHyperlink strpfad & Dateiname
Else
MsgBox ("Sowas.... Nummer wurde ( noch ) nicht vergeben !!")
End If
End Sub
Nun möchte ich gerne auch alle Unterordner durchsuchen und dann die XLSX-Datei geöffnet wird.
Ich bekomme das nicht hin, kann mir bitte jemand helfen.
Mit freundlichen Grüßen
Manfred

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel 2013 Unterordner durchsuchenn
12.08.2021 14:06:11
Nepumuk
Hallo Manfred,
teste mal:

Option Explicit
Sub Antrag_suche()
Const FOLDER_PATH As String = "P:\01_Antraege\"    'das ist der Ordner
Dim astrFolders() As String, strFilename As String, strSearch As String
Dim ialngFolders As Long
strSearch = ActiveCell.Value
astrFolders = GetFolders(FOLDER_PATH)
For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
strFilename = Dir$(astrFolders(ialngFolders) & strSearch & "*.xlsx") 'Der Dateiname suchen
If strFilename  vbNullString Then Exit For
Next
If strFilename  vbNullString Then
Call ThisWorkbook.FollowHyperlink(astrFolders(ialngFolders) & strFilename)
Else
Call MsgBox("Sowas.... Nummer wurde ( noch ) nicht vergeben !!", vbExclamation, "Hinweis")
End If
End Sub
Private Function GetFolders(ByVal pvstrPath As String) As String()
Dim astrFolders() As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
ReDim Preserve astrFolders(ialngIndex1)
astrFolders(ialngIndex1) = pvstrPath
ialngIndex1 = 1
ialngIndex2 = 1
strPath = pvstrPath
Do
strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
Do Until strFolder = vbNullString
If strFolder  "." And strFolder  ".." Then
If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
ReDim Preserve astrFolders(0 To ialngIndex1)
astrFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = astrFolders
End Function
Gruß
Nepumuk
Anzeige
AW: Excel 2013 Unterordner durchsuchenn
12.08.2021 14:18:50
Manfred
Hallo Nepumuk,
vielen Dank dass du dir die Mühe machst.
Das Makro lauft durch ohne Fehlermeldung, aber die xlsx-Datei wird nicht geöffnet.
Die MsgBox("Sowas.... Nummer wurde ( noch ) nicht vergeben !!" öffnet aber
Mit freundlichen Grüssen
Manfred
AW: Excel 2013 Unterordner durchsuchenn
12.08.2021 14:28:22
Nepumuk
Hallo Manfred,
kann ich nicht nachvollziehen. Funktioniert bei mir einwandfrei.

In der Zelle: 12345
Dateiname: 12345_Dateiname_Kommen_Weiteres_Geschehen.xlsx
Irgendwo im Unter-Unter-Unter-Unterordner
Stimmt denn der Ordnerpfad?
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige