Word Dateien durchsuchen

Forumthread: Word Dateien durchsuchen

15.11.2020 15:34:10

stef26

Hallo liebe Excel VBA Profis,
ich habe ein kleines Problem bei dem ich eure Unterstützung bräuchte.
Ich habe in einem Ordner ca. 1500 Word Dateien.
In meiner Excelliste habe ich in einer Spalte A sehr viele Suchbegriffe.
Ich habe im Internet folgenden Code gefunden:


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

Wie kann man den Code so umschreiben, dass das Makro nach allen Begriffen der Spalte A sucht.
Ich bräuchte auch nur in welchen Dateien welcher Suchbegriff enthalten ist.
Im Makro wird zusätzlich noch angegeben, wo das Wort gefunden wurde. Bräuchte ich eigentlich gar nicht. Wenn man dies weglassen kann um dadurch die Suche schneller durchführen zu lassen, dann wäre das super, da ich bestimmt auch an die 1000 Suchbegriffe habe und befürchte, dass das Makro Tagelang läuft.
Hinter dem Suchbegriff sollten dann die Dateinamen der Word Dokumente stehen in denen der Suchbegriff enthalten ist.
Falls der Aufwand das Makro umzuschreiben nicht zu groß sind um das hier machen zu können, wäre das ne tolle Sache.
MfG
Stefan

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: ungeprüft

15.11.2020 18:29:49

Fennek
AW: ungeprüft

15.11.2020 19:47:05

Stef26
AW: Word Dateien durchsuchen

15.11.2020 19:15:46

volti
AW: Word Dateien durchsuchen

15.11.2020 19:44:16

Stef26
AW: Word Dateien durchsuchen

15.11.2020 19:44:32

Stef26

AW: ungeprüft

15.11.2020 18:29:49

Fennek

Hallo Stefan,
hier ein Versuch mit einem Xl-Makro, der im Sheet der Suchbegriffe gestartet wird:


' xl-VBA
Sub Suche_Word()
on error goto XL90:
c00 = "G:\OF\"		'  0 then
cells(i+1, columns.count).end(xltoleft).offset(,1) = c01
end if
next i
.Close -1
End With
c01=dir
Loop
End Sub

mfg

AW: ungeprüft

15.11.2020 19:47:05

Stef26

Hallo Fennek
besten dank für deine Unterstützung.
Werde am Montag gleich mal testen
Dankeschön und liebe Grüsse
Stefan

AW: Word Dateien durchsuchen

15.11.2020 19:15:46

volti

Hallo Stefan,
hier noch eine Variante, die die gefundenen Word-Dateien in getrennten Spalten ausgibt.
Kannst Du ja mal testen:

Code:
[Cc][+][-]

Option Compare Text

Sub Wordsuche()
 Dim vArrSuch As Variant, vArrData As Variant, sSpArr() As String
 Dim i As Integer, L As Long
 Dim sPfad As String, sDatei As String, T As String
 
 With ThisWorkbook.Sheets("Tabelle1")                       'Tabelle ggf. anpassen
    L = .Cells(Rows.Count, "A").End(xlUp).Row
    vArrSuch = .Range("A1:A" & L)
    vArrData = .Range("A1:A" & L)
 End With
 
 sPfad = "C:&bsol;Users&bsol;volti&bsol;Documents&bsol;Worddokumente&bsol;"          'Pfad anpassen
 sDatei = Dir(sPfad & "*.doc*")                             'Alle Doc-Typen
  
 Do Until sDatei = ""                                       'Alle Dateien durchgehen
    With GetObject(sPfad & sDatei)                          'Datei laden
       Application.StatusBar = sDatei & " wird durchsucht!"
       DoEvents
       For i = 1 To L
         If InStr(1, .Content, vArrSuch(i, 1), 1) > 0 Then
            vArrData(i, 1) = vArrData(i, 1) & "," & sDatei 'Dateinamen festhalten
         End If
       Next i
       .Close -1                                            'Datei schließen
     End With
     sDatei = Dir                                           'Nächste Datei
 Loop

 With Application
   .ScreenUpdating = False
   .EnableEvents = False
   .Calculation = xlCalculationManual
 End With
 
 With ThisWorkbook.Sheets("Tabelle2")                       'Tabelle ggf. anpassen
   For i = 1 To L
     sSpArr = Split(vArrData(i, 1), ",")                    'Zeile splitten
    .Cells(i, "A").Resize(1, UBound(sSpArr) + 1) = sSpArr   'Zeile ausgeben
   Next i
 End With
 
 With Application
   .ScreenUpdating = True
   .EnableEvents = True
   .Calculation = xlCalculationAutomatic
 End With
 
 MsgBox "Fertig", vbInformation, "Suche"
 
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: Word Dateien durchsuchen

15.11.2020 19:44:16

Stef26

Hallo Karl Heinz
besten Dank für deine Unterstützung
Werde am Montag gleich mal testen...
Danke und viele Grüße
Stefan

AW: Word Dateien durchsuchen

15.11.2020 19:44:32

Stef26

Hallo Karl Heinz
besten Dank für deine Unterstützung
Werde am Montag gleich mal testen...
Danke und viele Grüße
Stefan

Beliebteste Forumthreads (12 Monate)

Forumthread: Word Dateien durchsuchen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread