Daten in Ordner und Unterordner Suchen

Hallo zusammen,
ich bin neu hier im Forum, habe aber schon den einen oder anderen guten Tipp aus dem Forum verwenden können.
Ich konnte bereits einige sehr einfache Sachen über Makro (VBA) lösen.
Nun habe eine Idee wie ich einen Arbeitsschritt in einer Fertigungslinie vereinfachen könnte und somit meinen Mitarbeitern etwas Arbeit ersparen.
Leider habe ich keine große Erfahrung mit der Programmierung in VBA und weiß auch nicht ob das überhaupt lösbar ist.
Nun zu meiner Idee:
Ich habe in einer Zelle (Exeldatei 1) folgende Bezeichnungen (Bezeichnungen ändert sich durch eingaben von Mitarbeitern) stehen: Bsp.: "000_BG00_123"
Nach klick auf einen Butten möchte ich in einem Ordner und den Unterordnern nach einer zugehörigen Datei Suchen und diese öffnen.
Im Dateinamen sind immer die ersten zwei Bereiche der Bezeichnung vorhanden: Bsp. Dateinamen: "000_BG00_LK.xlsm"
Ist die Datei geöffnet soll in einer Spalte nach der Vollen Bezeichnung (also 000_BG00_123) gesucht werden.
In der gefundenen Zeile sollte dann 4 Spalten weiter rechts die Bestehende Zahl um den Wert einer Zahl welche z.B.: in Zelle "C4" der Exceldatei 1 steht erhöht werden.
Wäre sowas mit Makro lösbar?
Für eure Hilfe schon mal vielen Dank.
Gruß Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo zusammen,
@Piet: gute Arbeit. Zielt aber auf die Auflistung alle Dateien, nicht auf das finden eine bestimmte, was meinem Verstand nach nicht Christians Wunsch entspricht. Auch schwierig: die "Suche" und die "Ausgabe" sind sehr miteinander verflechtet, was eine Erkennung der Such-Algo nicht einfach macht.
Ich schlage folgende Code (nicht besser als Piet, nur mit einem anderen Fokus):
Ich setze auf Early Binding, also Anbindung der Bibliothek durch den Projekt-Verweise, damit hat man Intellisense und Objekt-Katalog sofort verfügbar. Man kann damit direkt
Dim FSO as FileSystemObject
anstatt
Dim FSO as Object
Set FSO = CreateObject ("Scripting.Runtime")
Bei der Eingabe von EinzelTreffer = WAHR wird nach dem Finden der ersten Treffer abgebrochen, was die Suche beschleunigt. Sonst werden alle Treffer zurückgegeben. Muster-Beispiel 000_BG00_*.xlsm

Dim FSO As FileSystemObject
Dim Ergebnis
'ACHTUNG: Unter Anbindung ("Extras, "Verweise...") von der Bibliothek "Microsoft Scripting Runtime"
Public Sub Datei_finden()
Dim NamensMuster As String
Dim Einzeltreffer As Boolean
Dim StartVerz  As String
Dim E
'Init
    NamensMuster = ActiveSheet.Range("C1")
    Einzeltreffer = ActiveSheet.Range("C2")
    StartVerz = ActiveSheet.Range("C3")
    Ergebnis = Array() 'Dummy-Array mit UBound() = -1
    Set FSO = New FileSystemObject
'Start
    If NamensMuster > "" Then
    'Suchen
        Datei_finden_rek NamensMuster, StartVerz, Einzeltreffer
    'Ergebnis durchgehen
        For Each E In Ergebnis
            Debug.Print E 'Ausgabe in Direktfenster
        Next
    End If
End Sub
Private Function Datei_finden_rek(NamensMuster As String, StartVerz As String, Einzeltreffer As Boolean) As Boolean
'Return True, wenn Datei gefunden wurde (für "Einzeltreffer" relevant)
Dim F As file
Dim V As Folder
'Dateien im Verzeichnis prüfen
    For Each F In FSO.GetFolder(StartVerz).Files
        If F.Name Like NamensMuster Then
            ReDim Preserve Ergebnis(UBound(Ergebnis) + 1)
            Ergebnis(UBound(Ergebnis)) = StartVerz & "\" & F.Name
            Datei_finden_rek = True
            If Einzeltreffer Then Exit Function 'nicht weitersuchen: erste Treffer gefunden
        End If
    Next
'Subverzeichnisse durchsuchen (
    For Each V In FSO.GetFolder(StartVerz).SubFolders
        Datei_finden_rek = Datei_finden_rek(NamensMuster, V.Path, Einzeltreffer)
        If Datei_finden_rek And Einzeltreffer Then Exit Function 'step out of recursivity
    Next
End Function

(ungetestet)
VG
Yal

Dim NA As String NA = ThisWorkbook.Worksheets("Auswahl").Range("B66").Value Dim MG As String MG = ThisWorkbook.Worksheets("Auswahl").Range("B65").Value Dim Pfad As String Pfad = ThisWorkbook.Worksheets("Auswahl").Range("B70").Value With Workbooks.Open(Filename:=Pfad) Dim WB As String WB = ActiveWorkbook.name End With Windows(WB).Activate Sheets("Datenerfassung").Select Dim c As Range Dim firstAddress As String With Worksheets("Datenerfassung").Range("H21:H300") Set c = .Find(What:=NA, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Range(firstAddress).Select Selection.Offset(0, 4) = .Value + MG End If End With End Sub

Sub Wert_aufwerten() Dim NA As String Dim MG As Double Dim WB As Workbook Dim c As Range With ThisWorkbook.Worksheets("Auswahl") NA = .Range("B66").Value MG = .Range("B65").Value Set WB = Workbooks.Open(Filename:=.Range("B70").Value) End With With WB.Worksheets("Datenerfassung").Range("H21:H300") Set c = .Find(What:=NA, LookIn:=xlValues) If Not c Is Nothing Then c.Offset(0, 4) = c.Offset(0, 4).Value + MG End If End With End Sub

Beliebteste Forumthreads (12 Monate)

Daten in Ordner und Unterordner Suchen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

112 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten in Ordner und Unterordner Suchen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

112 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread