Clever-Excel-Forum

Hallo Leute,
heute geht es bei mir um ein Problem was mich schon seit Tagen beschäftigt und wozu ich bereits erfolglos englisch und deutschsprachige Foren durchsucht habe. Exclamation

Ich möchte in einem definierten Ordner die Dateien nach einen bestimmten Begriff durchsuchen. Wenn das Wort gefunden wird soll es in die Zelle geschrieben werden, der dazugehörige Pfad soll in der Nachbarspalte stehen. Alle Dokumente wo das Wort nicht gefunden wird, sollen in einer anderen Spalte aufgeführt werden.

Das war nach etwas Arbeit kein Problem.
Ich suche derzeit nach einer Möglichkeit, dass gleichzeitig nach einen zweiten Begriff gesucht werden soll. Wenn eins der beiden Wörter auftaucht (also als ODER zu verstehen) soll das Dokument aufgelistet werden. Dokumente wo beide Wörter nicht aufgefunden werden, sollen in einer anderen Spalte auflistet werden. Ich habe versucht mit einer zweiten If Schleife dies zu Lösen, leider ohne Erolg.

Mein bisheriger Ansatz sieht wiefolgt aus:

Code:
Sub GetDocData()

Application.ScreenUpdating = False

Dim wdApp As New Word.Application, wdDoc As Word.Document, WkSht As Worksheet

Dim strFolder As String, strFile As String, r As Long, n As Long, s As Long

strFolder = GetFolder

If strFolder = "" Then Exit Sub

Set WkSht = ActiveSheet

r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row 'r Wort 1

n = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row 'n Ausschuss

s = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row 's Wort 2

wdApp.WordBasic.DisableAutoMacros

strFile = Dir(strFolder & "\*.doc", vbNormal)

While strFile <> ""

  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)

  With wdDoc 'Loop 1 Wort 1

                With .Range.Find 'Wort 1

                  .ClearFormatting

                  .Replacement.ClearFormatting

                  .MatchWholeWord = True

                  .MatchCase = True

                  .Wrap = wdFindStop

                  .Text = WkSht.Cells(1, 1).Text

                  '.Text = WkSht.Cells(2, 1).Text

                  .Execute

                  If .Found = True Then

                    r = r + 1

                    WkSht.Cells(r, 1) = strFile

                   WkSht.Cells(r, 2) = strFolder

                                Else:

                                With .Range.Find 'Startet Loop Wort 2

                                .ClearFormatting

                                .Replacement.ClearFormatting

                                .MatchWholeWord = True

                               .MatchCase = True

                               .Wrap = wdFindStop

                                .Text = WkSht.Cells(2, 1).Text

                                .Execute

                                If .Found = True Then

                                  s = s + 1

                                  WkSht.Cells(s, 3) = strFile

                                 WkSht.Cells(s, 4) = strFolder

                                    Else: 'Wenn Beide Wörter nicht gefunden

                                          n = n + 1

                                          WkSht.Cells(n, 5) = strFile

                                         WkSht.Cells(n, 6) = strFolder

                                        'Kill (wdDoc) eigener Macro

                                End If 'Loop 2

                                End With 'End With Loop2

                    End If 'Loop 1

                    End With 'End With Loop 1

    .Close SaveChanges:=False

  End With 'End With Doc

  strFile = Dir()

Wend

wdApp.Quit

Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing

Application.ScreenUpdating = True

End Sub

Function GetFolder() As String

    Dim oFolder As Object

    GetFolder = "" 

    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)

    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path

    Set oFolder = Nothing

End Function

Beim Starten kommt die Meldung für das "With.Range.Find 'Startet Looü Wort 2", dass das Objekt oder die Methode nicht gefunden wird.
Ohne die Zeile Läuft das Makro, aber er findet kein Ergbenisse für das 2. Wort.

Vielleicht kennt einer von euch eine Lösung.
Es darf auch ein anderer Ansatz sein wie man einen 2. Suchbegriff in die Funktion einbettet. Ebenfalls funktionierten "Or" oder einfach einer 2. Zeile ".Text=.." in der ersten Schleife nicht.
Falls Euch der Code zu unübersichtlich ist, kann ich den Orginalen, ohne 2. If Schleife auch geben.

Vielen Dank schon mal
BG

Hallo,

so wie ich das sehe, befindest Du Dich bereits in einem With, weshalb das zweite With dann wie .Range.Find.Range.Find wäre und somit nicht geht.
Versuche mal für das zweite With: With wdDoc.Range.Find

Gruß

Code:
Sub M_snb()

  on error goto XL90:

  c00 = "G:\OF\"

  c01 = Dir(c00 & "*.docx")

  sn = Array("Wort1", "Wort2")

  Do Until c01 = ""

      With GetObject(c00 & c01)

        x = InStr(.Content, sn(0))

        y = InStr(.Content, sn(1))

        .Close -1

      End With

      c02 = c02 & "|" & c01 & "_" & sn(0) & ": " & x & "  " &  sn(1) & ": " & y

      c01=dir

    Loop

XL90:    

    st = Split(c02, "|")

    Cells(1).Resize(UBound(st)) = Application.Transpose(st)

End Sub

Drummer_LP

maninweb

snb