Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1892to1896
1892to1896
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Datei suchen

Forumthread: Datei suchen

Datei suchen
18.08.2022 11:22:00
Marcus
Hallo zusammen,
ich bin auf der Suche nach einem Code der folgendes können sollte, bitte:
Ich muss Dateien die einen gleichen bzw. ähnlichen Namen haben suchen und abändern. Derzeit sind es 707 Hauptverzeichnisse und jeweils 5 bis 13 Unterverzeichnisse
Hier muss ich Gebietsansprechpartner und Margen abändern.
Jetzt wäre mein Wunsch das der Code mich nach dem Namen der Datei fragt und mir dann alle Dateien die so ähnlich heißen mit Hyperlink auflistet.
z.B makita
jetzt sollte als Ergebnis alles aufgelistet werden wo makita drin vorkommt und das mit Hyperlink
Hat jemand einen Tipp?
Danke
Marcus
Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datei suchen
18.08.2022 11:47:06
Rudi
Hallo,
aus meiner Mottenkiste:

Option Explicit
Dim wksStart As Worksheet, wksInhalt As Worksheet, vntFiles(), lngFiles As Long
Dim strSuch As String
Sub prcFolders()
Dim FSO As Object, oFolder As Object
Dim strFolder As String
Application.ScreenUpdating = False
Set wksStart = ThisWorkbook.Sheets("Start")
On Error Resume Next
Set wksInhalt = ThisWorkbook.Sheets("Inhalt")
On Error GoTo 0
If wksInhalt Is Nothing Then
Set wksInhalt = Worksheets.Add
wksInhalt.Name = "Inhalt"
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
strFolder = wksStart.Cells(1, 2)
If strFolder = "" Then strFolder = GetDirectory
If strFolder = "" Then Exit Sub
strSuch = Application.InputBox("Dateiname?", "Suchbegriff")
If strSuch = "Falsch" Then Exit Sub
strSuch = LCase("*" & strSuch & "*")
Set oFolder = FSO.getfolder(strFolder)
lngFiles = 1
With wksInhalt
.Range("A:C").ClearContents
.Cells(1, 1) = "Pfad"
.Cells(1, 2) = "Dateiname"
.Range(.Cells(1, 1), .Cells(1, 3)).Font.Bold = True
End With
prcFiles oFolder
prcSubFolders oFolder
With wksInhalt
.Range(.Cells(2, 1), .Cells(lngFiles, 2)).FormulaLocal = WorksheetFunction.Transpose(vntFiles)
.Activate
End With
End Sub
Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.subfolders
prcFiles oSubFolder
prcSubFolders oSubFolder
Next
End Sub
Sub prcFiles(oFolder)
Dim oFile As Object
For Each oFile In oFolder.Files
If LCase(oFile.Name) Like strSuch Then
ReDim Preserve vntFiles(1 To 2, 1 To lngFiles)
vntFiles(1, lngFiles) = oFolder.Path
vntFiles(2, lngFiles) = "=hyperlink(""" & oFile.Path & """;""" & oFile.Name & """)"
lngFiles = lngFiles + 1
End If
Next
End Sub
Gruß
Rudi
Anzeige
AW: Datei suchen
18.08.2022 12:02:12
Marcus
@Rudi wie benutzte ich deine Datei?
Was muss ich dafür einstellen? Fehlermeldung GetDirectory
AW: Datei suchen
18.08.2022 13:01:34
Rudi
stimmt. da fehlt noch was.
Besser so:

Sub prcFolders()
Dim FSO As Object, oFolder As Object
Dim strFolder As String
Application.ScreenUpdating = False
Set wksStart = ThisWorkbook.Sheets("Start")
On Error Resume Next
Set wksInhalt = ThisWorkbook.Sheets("Inhalt")
On Error GoTo 0
If wksInhalt Is Nothing Then
Set wksInhalt = Worksheets.Add
wksInhalt.Name = "Inhalt"
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
strFolder = wksStart.Cells(1, 2)
If strFolder = "" Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "c:\"  'anpassen
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
End If
If strFolder = "" Then Exit Sub
strSuch = Application.InputBox("Dateiname?", "Suchbegriff")
If strSuch = "Falsch" Then Exit Sub
strSuch = LCase("*" & strSuch & "*")
Set oFolder = FSO.getfolder(strFolder)
lngFiles = 1
With wksInhalt
.Range("A:C").ClearContents
.Cells(1, 1) = "Pfad"
.Cells(1, 2) = "Dateiname"
.Range(.Cells(1, 1), .Cells(1, 3)).Font.Bold = True
End With
prcFiles oFolder
prcSubFolders oFolder
With wksInhalt
.Range(.Cells(2, 1), .Cells(lngFiles, 2)).FormulaLocal = WorksheetFunction.Transpose(vntFiles)
.Activate
End With
End Sub

Anzeige
AW: Datei suchen
25.08.2022 13:47:16
Marcus
sorry für die späte Rückmeldung.
Funktioniert einwandfrei
danke
marcus
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige