Office: (Office 2010) Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen

Gold_Phönix · 23. Mai 2011

So ich habe jetzt eine Schleife eingebaut, wo er die Zeichentabelle zeilenweise durchgeht. Mit Bla funktioniert das auch gut nur mit meinen Zeichen nicht zb. MT-2011-3789

Code:

Option Compare Database

'========================================================
'= Fernglas
'========================================================

'###################################
'# Aufruf Funktion mit dem Startordner
'###################################
Function OrdnerDateienAuslesen(ByVal strOrdner As String)
Dim fso As Object
Dim objFld As Object
Dim objSubFld As Object
Dim objFiles As Object
Dim fld, file
Dim rs As DAO.Recordset
Dim db As DAO.Database
' Textdokument durchsuchen
Dim oWord As Word.Application
Dim Doc As Word.Document
Set oWord = CreateObject("Word.application")

'# Recordset referenzieren
Set db = CurrentDb
Set rs = db.OpenRecordset("tblDateien", dbOpenDynaset)
'# File-System-Object, Startordner, Unterordner referenzieren
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFld = fso.GetFolder(strOrdner)
Set objFiles = objFld.Files
For Each file In objFiles
MsgBox (objFld.Path & "\" & file.Name & " wird durchsucht")
Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)
Dim zs As Recordset
Set zs = CurrentDb.OpenRecordset("Zeichen", dbOpenSnapshot)
For Each aword In Doc.Content.Words
Do Until zs.EOF
If aword.Text = zs![Bezeichnung] Then
MsgBox ("If " & zs![Bezeichnung])
rs.AddNew
'# Gesuchte Bezeichnung einfügen
rs!Bezeichnung = aword.Text
'# Neuen Pfad speichern
rs!DateiPfad = objFld.Path
'# Dateiname speichern
rs!Dateiname = file.Name
rs.Update

Else
MsgBox ("Else " & zs![Bezeichnung])
End If
zs.MoveNext
Loop
Next aword

Doc.Close
Set oWord = Nothing
Set Doc = Nothing

Next file
Set objSubFld = objFld.SubFolders
For Each fld In objSubFld
'# Rekursiver Aufruf
OrdnerDateienAuslesen fld
Next fld
'# Objektreferenzen zerstören
Set db = Nothing
rs.Close
Set fso = Nothing
Set objFld = Nothing
End Function

'###################################
'# Aufruf der Funktion, z. B. auch im Formular möglich
'###################################

Private Sub Befehl5_Click()
'# Vorher löschen
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tblDateien"
DoCmd.SetWarnings True

Dim oWord As Word.Application
Dim Doc As Word.Document
Set oWord = CreateObject("Word.application")
oWord.Visible = False
OrdnerDateienAuslesen "Z:\Newsletter\test"
'Wenn deine Schleife spaäter fertig ist:
oWord.Quit
Set oWord = Nothing
MsgBox ("OrdnerDateienAuslesen Z:\Newsletter\test ist fertig")
'# Nachher die Datensätze löschen, wo keine Datei vorhanden
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tblDateien WHERE isnull(DateiName)"
DoCmd.SetWarnings True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gold_Phönix · 7. Januar 2021

von Atrus2711

Wir waren schon bei einer anderen Funktion, die flexibler war (was z.B. auch silbengetrennte Worte angeht).
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Funktion hat aber doch nicht funktioniert, ich habe sie nun in meinen neuen Code eingebaut und sie gibt immer noch den gleichen Fehlercode aus:

Code:

Option Compare Database

'========================================================
'= Fernglas
'========================================================

'###################################
'# Aufruf Funktion mit dem Startordner
'###################################
Function OrdnerDateienAuslesen(ByVal strOrdner As String)
Dim fso As Object
Dim objFld As Object
Dim objSubFld As Object
Dim objFiles As Object
Dim fld, file
Dim rs As DAO.Recordset
Dim db As DAO.Database
' Textdokument durchsuchen
Dim oWord As Word.Application
Dim Doc As Word.Document
Set oWord = CreateObject("Word.application")

'# Recordset referenzieren
Set db = CurrentDb
Set rs = db.OpenRecordset("tblDateien", dbOpenDynaset)
'# File-System-Object, Startordner, Unterordner referenzieren
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFld = fso.GetFolder(strOrdner)
Set objFiles = objFld.Files
For Each file In objFiles
MsgBox (objFld.Path & "\" & file.Name & " wird durchsucht")
Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)
Dim zs As Recordset
Set zs = CurrentDb.OpenRecordset("Zeichen", dbOpenSnapshot)
'For Each aword In Doc.Content.Words
Do Until zs.EOF
If SearchWordString(zs![Bezeichnung], oWord) Then
'If aword.Text = zs![Bezeichnung] Then
MsgBox ("If " & zs![Bezeichnung])
rs.AddNew
'# Gesuchte Bezeichnung einfügen
rs!Bezeichnung = aword.Text
'# Neuen Pfad speichern
rs!DateiPfad = objFld.Path
'# Dateiname speichern
rs!Dateiname = file.Name
rs.Update

Else
MsgBox ("Else " & zs![Bezeichnung] & " wurde nicht gefunden")
End If
zs.MoveNext
Loop
'Next aword

Doc.Close
Set oWord = Nothing
Set Doc = Nothing

Next file
Set objSubFld = objFld.SubFolders
For Each fld In objSubFld
'# Rekursiver Aufruf
OrdnerDateienAuslesen fld
Next fld
'# Objektreferenzen zerstören
Set db = Nothing
rs.Close
Set fso = Nothing
Set objFld = Nothing
End Function

'###################################
'# Aufruf der Funktion, z. B. auch im Formular möglich
'###################################

Private Sub Befehl5_Click()
'# Vorher löschen
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tblDateien"
DoCmd.SetWarnings True

Dim oWord As Word.Application
Dim Doc As Word.Document
Set oWord = CreateObject("Word.application")
oWord.Visible = False
OrdnerDateienAuslesen "Z:\Newsletter\test"
'Wenn deine Schleife spaäter fertig ist:
oWord.Quit
Set oWord = Nothing
MsgBox ("OrdnerDateienAuslesen Z:\Newsletter\test ist fertig")
'# Nachher die Datensätze löschen, wo keine Datei vorhanden
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tblDateien WHERE isnull(DateiName)"
DoCmd.SetWarnings True
End Sub

'##############################
'# Function SearchWordString
'##############################

Function SearchWordString(sSearch As String, oWord As Word.Application) As Boolean

SearchWordString = False

With oWord.Selection.Find
.ClearFormatting
'zu suchenden Text übergeben
.Text = sSearch

'Text soll ersetzt werden durch
'.Replacement.Text = ""

'Suchrichtung
.Forward = True

'0 = Stop am Ende, 1= Nach Ende bis zur Cursorpos von vorne weiter suchen. 2= Fragen
.Wrap = wdFindContinue 'Wenn kein Wordverweis =1 oder die Const setzen!

'Format wie angegeben entfällt wohl aus Access
.Format = False

'Groß-Klein beachten
.MatchCase = True

'Nur ganzes Wort
.MatchWholeWord = True

'Suchtext enthält Joker
.MatchWildcards = False

'Ähnliche Schreibweise erlaubt
.MatchSoundsLike = False

'Suchvorgang nach allen Formen des Suchtexts gesucht werden soll (wenn beispielsweise "sitzen" gesucht wird, werden auch "gesessen" und "sitzend" gefunden)
.MatchAllWordForms = False
.Execute
If .Found Then
SearchWordString = True

End If
End With '.Find
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Objektvariable oder With-Blockvariable nicht festgelegt
markiert ist: With oWord.Selection.Find

Atrus2711 · 24. Mai 2011

Hi,

das dürfte daran liegen, dass du

oWord übergibst, das Dokument aber in Word (nicht oWord) läst. Damit bleibt oWord ohne aktives Dokument.

die Selection (Makrierung) auswertest, ohne dich darum zu kümmern, was selektiert ist. Wenn nichts markiert ist, wird nicht gesucht.

Gold_Phönix · 24. Mai 2011

Okay also bei der Funktion "oWord As Word.Application"
wieder in "oWord As Object" umstellen

aber ich verstehe das mit der Selection nicht

Atrus2711 · 24. Mai 2011

Die Suche sucht im Text, der in Word markiert ist. Manuell könntest du das Markieren durch Überstreichen mit der Maus erledigen. Aber im Code wird ja blind oWord.Selection.Find ausgeführt. Diese Selection ist möglicherweise leer. Und was dann durchsucht wird, weiß ich nicht auswendig.

Gold_Phönix · 24. Mai 2011

Ne ich möchte ja das das ganze Dokument durchsucht wird. Von A-Z

Atrus2711 · 24. Mai 2011

Hier die neue Komplettlösung.

Tabelle Dokumente enthält die zu durchsuchenden Dokumente
Tabelle Suchbegriffe enthält die Suchbegriffe.

Jedes Dok wird auf jedes Wort untersucht. Das Ergebnis gelangt in die Ausgabeabelle.

Demodoks anbei: für Demo alles entpacken nach c:\delme und Sub starten.

Gold_Phönix · 27. Juli 2011

Danke das funktioniert super *Smilie

qo7300 · 22. November 2011

Hallo zusammen,

das ganze hört sich gut an. Sowas ähnliches suche ich auch. Die Suchbegriffe bei mir stehen zwar auf einem Formular und nicht in einer Tabelle aber das würde ich schon umbasteln können, nur:

SearchWordString scheint nicht in Access 2002/XP vorhanden zu sein.

Gibt es auch eine einfache Lösung für diese alte Version ?

Gruß
Uli

Atrus2711 · 22. November 2011

Hi,

Serachwordstring ist im Modul enthalten. Was in 2002 anders sein wird, sind die Verweise. Setzt mal in VBA den Verweis von Word 12 (=2007) auf deine Version um, und kompiliere. Ich selbst hab kein 2002 mehr zur Hand, aber der Suchbefehl ist ja schon älter, der ist bestimmt in 2002 auch noch da.

qo7300 · 23. November 2011

Nach dem Korrigieren der Verweise funktioniert es auch bei mir.

Gruß Uli

Office: (Office 2010) Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen

Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen

Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen

Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen

Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen

Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen - Similar Threads - Access Word Dokumente

Word-Dokument über Access erstellen und bearbeiten

Word Dokument aus Access füllen

word dokument aus access füllen; Fehler 6028

Exportieren von Access-Daten in ein Word-Dokument

Access Tabelle in Word-Dokument

Word Dokument aus Formular erstellen mit Tabelleneinträgen

Access Datenbank in Word Dokument