Unterordner durchsuchen
03.01.2021 17:52:29
Michael
mit u,g. Code werden Daten aus Zellen mit PDF -Dateien auf dem Server verglichen und verlinkt.
Dies funktioniert schon sehr gut , aber es wird nur der ausgewählte Ordner durchsucht und verlinkt.
Es werden immer mehr Aufträge nach Maschinen und Datum in vielen Unterordnern gespeichert. Da ich alle 2 -3 Wochen die Daten verlinke muss jeden einzelnen Ordner auswählen, es Nervt und kostet Zeit.
Wie kann ich es realisieren dass, auch die Unterordner durchsucht werden ?
Danke vorab für Eure Hilfe.
Sub Verlinken()
Dim L As Long
Dim cnt As Long
Dim lngLRow As Long
Dim strOrdner As String
Dim passwd As String
passwd = InputBox("Bitte Passwort eingeben.")
If passwd "123" Then
MsgBox "Falsches Passwort", vbCritical, "Falsches Passwort"
Exit Sub
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "X:\B\Produktion\Archiv\Test\2020"
.Title = "Ordner auswählen..."
.ButtonName = "Auswahl"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1) "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
If strOrdner = "" Then
MsgBox "Abbruch durch Benutzer (Kein Ordner ausgewählt)"
Exit Sub
End If
lngLRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
cnt = 0
If lngLRow "" Then
.Hyperlinks.Add anchor:=.Range("E" & L), Address:=strOrdner & "\" & .Range("E" & L). _
_
_
Value & ".pdf"
cnt = cnt + 1
End If
Next
End With
Sheets("MF_Buch").Protect Password:="123"
MsgBox "Bei " & cnt & " von " & L - 10 & " Auftragsnummern wurde ein PDF Dokument verlinkt"
End Sub