Zum Inhalt springen

Excel Tool


stereotype

Empfohlene Beiträge

  • 4 Wochen später...

Hi!

Wenn ich Dich richtig verstanden habe, willst Du in allen Arbeitsmappen Deines Systems nach z.B. einem Suchwort suchen, oder??

Das ganze geht unter VBA und zwar mit Hilfe des FileSystemObjects!

Dafür im VBA-Editor unter Excel in Extras->Verweise die Microsoft Scripting Runtime aktivieren, falls noch nicht geschehen!

Hab mich mal 'n bissel hingesetzt und was altes von mir umgeschrieben!

Sag Bescheid, ob es das ist, was Du wolltest!


Sub suchemuster()

Dim fso As New Scripting.FileSystemObject

Dim rootfld As Scripting.Folder

Dim msg As String

'Hier den "Aufsetzpunkt angeben"

Set rootfld = fso.GetFolder("C:\eigene dateien")

'Starte Rekursion

suchefileinfolder rootfld

MsgBox "Fertig!"

End Sub



Sub suchefileinfolder(rootfld As Folder)

Dim fso As New Scripting.FileSystemObject

Dim fld As Scripting.Folder

Dim fil As Scripting.file

Dim actwrk As Workbook

Dim actsht As Worksheet

Dim txtfile As Scripting.TextStream

Dim suchwort As String


'Hier das Suchwort anpassen


suchwort = "EUR"


For Each fld In rootfld.SubFolders

    'Rekursiv alle Verzeichnisse mit Unterverzeichnissen durcharbeiten

    'Hätte man auch Iterativ schreiben können, aber ich liebe Rekursive Prozeduren :-)

    suchefileinfolder fld

Next

'Postrekursiver Teil

'TextFile für die Ergebniss

'Könnte man auch als Excel-Tabelle machen, war mir aber zuviel arbeit

'Achtung! Die Textdatei wird nicht gelöscht!!! Das heisst, evtl. bleiben alte Ergebnisse stehen!

Set txtfile = fso.OpenTextFile("C:\ergebnis.txt", ForAppending, True)

For Each fil In rootfld.Files

    'Wenn Excel-Tabelle

    If Right(fil.Name, 4) = ".xls" Then

        'öffnen

        Set actwrk = Workbooks.Open(fil.Path)

        'Für jedes Tabellenblatt in der Mappe

        For Each actsht In actwrk.Sheets

            If Not actsht.UsedRange.Find(suchwort) Is Nothing Then

                'Wenn wenigstens einer(!) gefunden wurde, dann schreibe

                'in die Ergebnisdatei und...

                txtfile.Write fil.Path & vbCrLf

                'beende die For-Schleife

                Exit For

            End If

        Next

        'Arbeitsmappe schliessen (ohne speichern) und

        'Objekte freigeben

        actwrk.Close xlDoNotSaveChanges

        Set actwrk = Nothing

        Set actsht = Nothing

    End If

Next

'Textdatei schliessen

txtfile.Close

Set txtfile = Nothing

End Sub

Viel Spass damit,

Red Bull

Link zu diesem Kommentar
Auf anderen Seiten teilen

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...