PDA

Vollständige Version anzeigen : Mit Access mehrere Word-Dokumente nach bestimmten Zeichenfolgen durchsuchen


Gold_Phönix
12.05.2011, 11:12
Hallo Leute,
möchte folgende Idee umsetzen:

In einer Tabelle von Access möchte ich mehrere Zeichenfolgen untereinander eingeben z.b.:
1.Zeile MT-2011-3789
2.Zeile MT-2010-467
usw.

Nun habe ich einen Ordner mit mehreren Unterordnern, wo verschiedene Word-Dokumente liegen. Diese sollen alle durchsucht werden.

Also es soll folgendermaßen ablaufen.

1. Zeile MT-2011-3789 -> Aktuellstes Dokument öffnen und durchsuchen, Zeichenfolge gefunden = Speicher den Namen des Dokuments in die Zeile neben der Zeichenfolge, Zeichenfolge nicht gefunden = Nächstes Dokument öffnen und durchsuchen usw.
2.Zeile das gleiche und mit den darauffolgenden Zeilen auch

Ich hätte das auch gerne mit Excel gelöst, aber da ich dann nach der fertigen Suche die Liste nach den abgespeicherten Namen der Word-Dokumente sortieren muss, stimmen die Werte ja nicht überein.

Kann man meine Idee so wie ich das möchte umsetzen?

Einfacher und schneller würde die Suche laufen, wenn man das aktuellste Dokument öffnet und dann alle Zeichenfolgen durchgeht und dann bei erfolgreicher Suche den Namen des Dokuments abspeichert. Und dann das nächste Dokument öffnet und die übrigen Zeichenfolgen durchgeht usw.
Nur reichen meine Kenntnisse nicht aus, wie ich Access verklicker, nur die restlichen Zeichenfolgen auszuwählen......

ebs17
12.05.2011, 12:34
Ich würde einfach die Worddokumente so wie sie kommen durchlaufen, pro Dokument die Stichwortliste durchgehen und Dokumentname und gefundenes Stichwort in eine Tabelle schreiben. Das geht sowohl in Access als auch in Excel, sortieren kann man auch in Excel.

Gold_Phönix
17.05.2011, 09:55
Also das ich ein Dokument öffne, das habe ich hinbekommen. Aber ich möchte ja, das alle Dokumente im Ordner geöffnet werden.
Aber eigentlich möchte ich ja, das die Dokumente nur durchsucht werden. Die brauchen nicht geöffnet zu werden. Aber ich habe im Internet nichts brauchbares zum Durchsuchen gefunden.

Option Compare Database

Private Sub Befehl4_Click()
'Testdokument öffnen

Dim oApp As Object
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
oApp.Documents.Open ("Z:\Pfad\testordner\")
'oApp.Documents.Open ("Z:\Pfad\test.docx")


End Sub


Edit:

Okay hab was gefunden aber ich stehe wie schon vorher vor dem Problem, das er mir Word As Word.Application nicht kompilieren möchte und einen Fehler anzeigt: Benutzerdefinierter Typ nicht definiert

Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim Word As Word.Application
Dim Doc As Word.Document
Set Word = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Pfad\test.docx")

Word.Visible = False

For Each aword In Doc.Content.Words

If aword.Text = "MT-2011-3789" Then

MsgBox ("MT-2011-3789 GEFUNDEN")

Else

End If

Next aword


Word.Quit


Set Word = Nothing
Set Doc = Nothing





'Testdokument öffnen

'Dim oApp As Object
'Set oApp = CreateObject("Word.Application")
'oApp.Visible = True
'oApp.Documents.Open ("Z:\Newsletter\test\")
'oApp.Documents.Open ("Z:\Newsletter\test.docx")


End Sub

Atrus2711
17.05.2011, 10:30
Hi,

du wirst da einen Verweis auf Word brauchen: im VBA-Editor Extars/verweise wählen, da dann Microsoft Word in deiner Version anklicken.

Gold_Phönix
17.05.2011, 10:50
ah ja danke, daran hab ich überhaupt nicht gedacht :)

So jetzt kommt keine Fehler Meldung mehr aber der Code funktioniert nicht
habe ihn etwas geändert um den Fehler finden zu können:

Option Compare Database


Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim Word As Word.Application
Dim Doc As Word.Document
Set Word = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Pfad\test.docx")

Word.Visible = True

For Each aword In Doc.Content.Words

If aword.Text = "MT-2011-3789" Then
MsgBox ("MT-2011-3789 GEFUNDEN")

Else
MsgBox ("MT-2011-3789 NICHT GEFUNDEN")

End If

Next aword


Word.Quit


Set Word = Nothing
Set Doc = Nothing



'Testdokument öffnen

'Dim oApp As Object
'Set oApp = CreateObject("Word.Application")
'oApp.Visible = True
'oApp.Documents.Open ("Z:\Pfad\test\")
'oApp.Documents.Open ("Z:\Pfad\test.docx")


End Sub


Die Datei wird im Hintergrund geöffnet und dann wird mir 13mal die MsgBox ("MT-2011-3789 NICHT GEFUNDEN") angezeigt und die Datei wird wieder geschlossen.
Aber in der Datei steht MT-2011-3789
Dies ist ihr Inhalt:
Bla bla

CVE-2011-1485
Bla bla

Atrus2711
17.05.2011, 11:34
Hi,

du durchsuchst jedes Wort. Es genügt, wenn der gesuchte Begriff auch nur ein einziges Mal auftaucht. Damit ist das Dokument schon "eingetütet", und die Schleife kann mit Exit For verlassen werden.

"Negativmeldungen" sind hingegen ziemlich unnütz. Und Mehrfachpositivmeldungen auch.

For Each aword In Doc.Content.Words
If aword.Text = "MT-2011-3789" Then
MsgBox ("MT-2011-3789 GEFUNDEN")
Exit For
Else
'nicht gefunden. Nichts zu tun; weitersuchen. End If
Next aword

Ich bin übrigens nicht sicher, ob ein Begriff, der Bindestriche enhält, als ein Wort erkannt wird. Teste es doch vorher mal mit einem Wort "am Stück". Wenn das klappt, machen wir uns weitere Gedanken.

Gold_Phönix
17.05.2011, 11:40
Ah danke ich werde es sofort ausprobieren, versuche gerade aus zwei Codes einen zu machen

1.Code den kennen wir ja schon
Option Compare Database


Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim Word As Word.Application
Dim Doc As Word.Document
Set Word = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Pfad\test.docx")

Word.Visible = True

For Each aword In Doc.Content.Words

If aword.Text = "MT-2011-3789" Then
MsgBox ("MT-2011-3789 GEFUNDEN")

Else
MsgBox ("MT-2011-3789 NICHT GEFUNDEN")

End If

Next aword


Word.Quit


Set Word = Nothing
Set Doc = Nothing



'Testdokument öffnen

'Dim oApp As Object
'Set oApp = CreateObject("Word.Application")
'oApp.Visible = True
'oApp.Documents.Open ("Z:\Pfad\test\")
'oApp.Documents.Open ("Z:\Pfad\test.docx")


End Sub

2.Code ist neu und gibt alle Dateien mit ihren Pfaden im Ordner an

'###################################
'# 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

'# 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
rs.AddNew
'# Neuen Pfad speichern
rs!DateiPfad = objFld.Path
'# Dateiname speichern
rs!Dateiname = file.Name
rs.UpDate
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
'###################################
Sub Auslesen()
'# Vorher löschen
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tblDateien"
DoCmd.SetWarnings True
OrdnerDateienAuslesen "C:\Temp"
'# 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

Und nun das was ich daraus gebastelt habe:



'###################################
'# 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 Word As Word.Application
Dim Doc As Word.Document
Set Word = 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
Set Doc = Word.Documents.Open(file)
Word.Visible = True
For Each aword In Doc.Content.Words
If aword.Text = "MT-2011-3789" Then
MsgBox ("MT-2011-3789 GEFUNDEN")
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 ("MT-2011-3789 NICHT GEFUNDEN")
End If
Next aword
Word.Quit
Set Word = 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
OrdnerDateienAuslesen "Z:\Pfad\test"
MsgBox ("OrdnerDateienAuslesen Z:\Pfad\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


Jetzt meckert er das die Typen unverträglich sind
Set Doc = Word.Documents.Open(file)

Gold_Phönix
17.05.2011, 11:58
so habe deinen Code mal mit meinem alten getestet:

Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim Word As Word.Application
Dim Doc As Word.Document
Set Word = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Pfad\test.docx")

Word.Visible = True

For Each aword In Doc.Content.Words
If aword.Text = "bla bla" Then
MsgBox ("bla bla GEFUNDEN ")
Exit For
Else
'nicht gefunden. Nichts zu tun; weitersuchen.
End If
Next aword

Word.Quit


Set Word = Nothing
Set Doc = Nothing

End Sub
'==============

bla wird gefunden
bla bla nicht

grzi
17.05.2011, 12:14
...
For Each aword In Doc.Content.Words
If aword.Text = "bla bla" Then
MsgBox ("bla bla GEFUNDEN ")
Exit For
Else
'nicht gefunden. Nichts zu tun; weitersuchen.
End If
Next aword
...



Hast du es mal mit Find von Word probiert? Arbeitet bei mir ganz problemlos und dir stehen alle Suchparameter die man sich wünschen kann zur Verfügung!
Nebenbei bemerkt: Dazu braucht man dann auch nicht jedes "Wort" eines Doc´s zu durchlaufen!

Gold_Phönix
17.05.2011, 12:19
hab jetzt meinen neuen Code mal umgestellt:


'###################################
'# 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 Word As Word.Application
Dim Doc As Word.Document
Set Word = 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)
Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)
MsgBox (objFld.Path & "\" & file.Name)
Word.Visible = False
For Each aword In Doc.Content.Words
If aword.Text = "bla" Then
MsgBox ("bla GEFUNDEN")
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 ("bla NICHT GEFUNDEN")
End If
Next aword
Word.Quit
Set Word = 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
OrdnerDateienAuslesen "Z:\Pfad\test"
MsgBox ("OrdnerDateienAuslesen Z:\Pfad\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



In dem Ordner test befinden sich drei Dateien

lalala.docx
tach.docx
trululou.docx

in tach befindet sich das bla

folgende Ausgabe:
Msgbox: Z:\Pfad\test\lalala.docx
Msgbox: Z:\Pfad\test\lalala.docx
Msgbox: bla NICHT GEFUNDEN
Msgbox: Z:\Pfad\test\trululou.docx

Laufzeitfehler 91
Objekvariable oder With-Blockvariable nicht festgelegt

Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name) ist markiert

Gold_Phönix
17.05.2011, 12:24
Meinst du diese Methode: Ausdruck.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte?

grzi
17.05.2011, 12:47
Hast du es mal mit Find von Word probiert? Arbeitet bei mir ganz problemlos und dir stehen alle Suchparameter die man sich wünschen kann zur Verfügung!
Nebenbei bemerkt: Dazu braucht man dann auch nicht jedes "Wort" eines Doc´s zu durchlaufen!

Meinst du diese Methode: Ausdruck.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte?

Schau mal in Word im VBA-Editor (Word-Entwicklerreferenz) unter:
Selection.Find-Eigenschaft

Hier mal so ein Beispiel:

Function SearchWordString(sSearch As String, oWord As Object) 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 With 'oWord.Selection.Find
End Function


Musst nur dein Suchwort und das Word-Object übergeben (Word.Application-Object). Liefert Wahr/True, wenn etwas passendes gefunden wurde.

Gold_Phönix
17.05.2011, 13:54
Hab es ausprobiert aber es funktioniert nicht. Vielleicht habe ich das auch nicht richtig verstanden

Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim Word As Word.Application
Dim Doc As Word.Document
Set Word = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Newsletter\test.docx")

Word.Visible = True

SearchWordString("bla", Word) = False


Word.Quit


Set Word = Nothing
Set Doc = Nothing

End Sub

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

Function SearchWordString(sSearch As String, oWord As Object) As Boolean

SearchWordString = False

With oWord.Selection
With .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 With '.Find
End With 'oWord.Selection
End Function

Fehlercode:
Fehler beim Kompilieren
Funktionsausfruf auf der linken Seite der Zuweisung muss den Typ Variant oder Object zurückgeben.

SearchWordString("bla", Word) = markiert

grzi
17.05.2011, 14:04
...
SearchWordString("bla", Word) = False
...



Das kann nicht gehen! ;)

...
MsgBox "Text gefunden: " & SearchWordString("bla", Word)
...

Ich empfehle dir wärmstens dein Word Objekt in oWord oder objWord umzunennen! So gehst du Problemen im VBA-Code aus dem Weg!

Gold_Phönix
17.05.2011, 14:29
oh ja hatte mich schon über diese komische Schreibweise gewundert.
Aber ich bekomme trotz Änderung wieder eine Fehlermeldung:
Laufzeitfehler 91
Objektvariable oder With-Blockvaraible nicht festgelegt

With .Find markiert
Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim oWord As Word.Application
Dim Doc As Word.Document
Set oWord = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Newsletter\test.docx")

oWord.Visible = True

MsgBox "Text gefunden: " & SearchWordString("bla", oWord)


oWord.Quit


Set oWord = Nothing
Set Doc = Nothing

End Sub

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

Function SearchWordString(sSearch As String, oWord As Object) As Boolean

SearchWordString = False

With oWord.Selection
With .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 With '.Find
End With 'oWord.Selection
End Function

grzi
17.05.2011, 14:53
...
Set Doc = Word.Documents.Open("Z:\Newsletter\test.docx")
...


Na fällt dir in der Zeile was auf? Wir reden nicht mehr von Word sondern von? :upps:

ebs17
17.05.2011, 17:09
Zum Suchen hätte ich auch eine Variante anzubieten:
' ...
Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)
' Recordsetschleife durch Stichworttabelle
If Instr(1, Doc.Content, rsStichwort(0)) > 0 Then
rs.AddNew
' weitere Anweisungen
End If

grzi
18.05.2011, 13:44
Zum Suchen hätte ich auch eine Variante anzubieten:
' ...
Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)
' Recordsetschleife durch Stichworttabelle
If Instr(1, Doc.Content, rsStichwort(0)) > 0 Then
rs.AddNew
' weitere Anweisungen
End If

@Ebs: Auch ein netter Ansatz ;)

Hast du - oder jemand anderes hier - Erfahrungen in Sachen Performance bei der Suche in Word/Excel, bzw. Tipps wie man das Ganze ohne Bremsen gestaltet?

Gold_Phönix
19.05.2011, 09:08
Na fällt dir in der Zeile was auf? Wir reden nicht mehr von Word sondern von? :upps:

Wenn ich dort aber Word in oWord umbenenne, stürzt Access ab

Gold_Phönix
19.05.2011, 09:20
Zum Suchen hätte ich auch eine Variante anzubieten:
' ...
Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)
' Recordsetschleife durch Stichworttabelle
If Instr(1, Doc.Content, rsStichwort(0)) > 0 Then
rs.AddNew
' weitere Anweisungen
End If

Irgendwie kapiere ich diese Anweisung nicht Instr(1, Doc.Content, rsStichwort(0)) > 0 Then
Gibt einen Integer-Wert zurück, der die Anfangsposition des ersten Auftretens einer Zeichenfolge innerhalb einer anderen Zeichenfolge angibt.
Wie kann man denn damit eine Tabelle durchlaufen?

Gold_Phönix
19.05.2011, 09:34
Dieser Code funktioniert für die erste Datei zum durchsuchen echt gut, wenn er aber die nächste Datei öffnet und durchsuchen möchte bekomme ich diesen Fehler:
Objektvariable oder With-Blockvariable nicht festgelegt
markiert ist oWord.Visible = False



'###################################
'# 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)
oWord.Visible = False
For Each aword In Doc.Content.Words
If aword.Text = "bla" Then
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

End If
Next aword
oWord.Quit
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
OrdnerDateienAuslesen "Z:\Newsletter\test"
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






Nachdem ich die Fehlermeldende Datei gelöscht habe habe ich bei der darauffolgenden Datei folgenden Fehler erhalten:
Der Remote-Server-Computer existiert nicht oder ist nicht verfügbar

markiert ist
Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)

Atrus2711
19.05.2011, 09:40
Hi,

wundert dich das? Du setzt am Ende der Schleife Set oWord = Nothing. Im nächsten Schleifenlauf krachts dann, weil oWord eben Nothing ist.

Überleg dir mal, welche Objektvariablen wie schnell "drehen" müssen, d.h. wie lange die leben und ihren Werte behalten sollen. Setze sie dementsprechend nicht zu früh auf Nothing. Und da eine Neuzuweisung die Altzuweisung überschreibt, ist ein Nothingsetzen eigentlich erst am Ende der Operationen nötig.

Und: wenn du eine Objektvariable oWord hast, solltest du die auch nutzen, anstatt auf Word zuzugreifen.

Und nochwas: es sollte genügen, oWord einmal visible zu setzen. Wenn die Instanz erhalten bleibt (s.o.) und nicht von dir auf Visible = False gesetzt wird, bleibt die sichtbar.

Code vestehen ist immer besser als Code zusammenzukopieren.... das klappt nur bei Doktorarbeiten.

Gold_Phönix
19.05.2011, 10:08
wundert dich das? Du setzt am Ende der Schleife Set oWord = Nothing. Im nächsten Schleifenlauf krachts dann, weil oWord eben Nothing ist.
Wenn ich Set oWord = Nothing ausklammer, bekomme ich trotzdem die gleiche Fehlermeldung

Und: wenn du eine Objektvariable oWord hast, solltest du die auch nutzen, anstatt auf Word zuzugreifen.

Ich habe es eben schon geschrieben, wenn ich Set Doc = Word.Documents.Open(objFld.Path & "\" & file.Name)
in
Set Doc = oWord.Documents.Open(objFld.Path & "\" & file.Name)
umbenene dann stürzt mit Access ab


Und nochwas: es sollte genügen, oWord einmal visible zu setzen. Wenn die Instanz erhalten bleibt (s.o.) und nicht von dir auf Visible = False gesetzt wird, bleibt die sichtbar.

Aber wie bekomme ich das dann hin, das er mir nicht alle Dateien öffnet. Es gibt ja nur 3 Testdateien aber die Dateien die ich eigentlich durchsuchen möchte, sind schon deutlich mehr

grzi
19.05.2011, 10:12
Wenn ich dort aber Word in oWord umbenenne, stürzt Access ab

??? Wie stürzt ab?
Wann stürzt Access ab?
Hast du mal vor und nach der Codezeile den Code angehalten um zu sehen ob es an der Zeile oder vielleicht wo ganz woanders hängt?

Die Function SearchWordString ist lauffähig und enthält soweit auch keinen Fehler!
Dies kannst du ja auch ohne "Schleife" testen, indem du die Function direkt aufrufst!
Kannst ja noch ein ErrorHandle einbauen um Fehler in deinem Code aufzudecken und abzufangen!

Und zeige mal deinen Code her, bei dem sich Access verabschiedet hat!

Aber wie bekomme ich das dann hin, das er mir nicht alle Dateien öffnet. Es gibt ja nur 3 Testdateien aber die Dateien die ich eigentlich durchsuchen möchte, sind schon deutlich mehr

indem du nach der Suche das Doc wieder schließt: DOC.Close
bevor du das nächste öffnest!

Gold_Phönix
19.05.2011, 11:08
??? Wie stürzt ab?
Wann stürzt Access ab?
Hast du mal vor und nach der Codezeile den Code angehalten um zu sehen ob es an der Zeile oder vielleicht wo ganz woanders hängt?

Die Function SearchWordString ist lauffähig und enthält soweit auch keinen Fehler!
Dies kannst du ja auch ohne "Schleife" testen, indem du die Function direkt aufrufst!
Kannst ja noch ein ErrorHandle einbauen um Fehler in deinem Code aufzudecken und abzufangen!

Und zeige mal deinen Code her, bei dem sich Access verabschiedet hat!


indem du nach der Suche das Doc wieder schließt: DOC.Close
bevor du das nächste öffnest!

Ähm Moment, ich glaube jetzt kommen wir mit zwei verschiedenen Codes durcheinander
SearchWordString ist eigentlich in einem anderen Code

kleine Aufklärung:
Ich habe ein Formular auf dem zwei Buttons sind.
Button 1 Suche starten ist Befehl4_Click()
Button 2 Fernglas ist Befehl5_Click()

Ich hatte erst den ersten Button und als ich dann aber einen anderen Code gefunden habe und ich den alten nicht komplett ausklammern wollte bzw.l mit einbinden wollte
habe ich den zweiten button erstellt...


Option Compare Database


Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim oWord As Word.Application
Dim Doc As Word.Document


Set oWord = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Newsletter\test.docx")

oWord.Visible = True

MsgBox "Text gefunden: " & SearchWordString("bla", oWord)


oWord.Quit


Set oWord = Nothing
Set Doc = Nothing

End Sub


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

Function SearchWordString(sSearch As String, oWord As Object) As Boolean

SearchWordString = False

With oWord.Selection
With .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
rs.AddNew
'# Gesuchte Bezeichnung einfügen
rs!Bezeichnung = sSearch
'# Neuen Pfad speichern
rs!DateiPfad = objFld.Path
'# Dateiname speichern
rs!Dateiname = file.Name
rs.Update

End If
End With '.Find
End With 'oWord.Selection
End Function

'========================================================
'= 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)
Word.Visible = False
For Each aword In Doc.Content.Words
If aword.Text = "bla" Then
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

End If
Next aword
Word.Quit
Set Word = 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
OrdnerDateienAuslesen "Z:\Newsletter\test"
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





Wenn ich Button1 drücke bekomme ich diese Fehlermeldung:
Objektvariable oder With-Blockvariable nicht festgelegt
und in der Function SearchWordString
wird mir With .Find markiert

Wenn ich Button2 drücke (fernglas)
dann bekomme ich diese Fehlermeldung:
Methode oder Datenobjekt nicht gefunden
und in der Function OrdnerDateienAuslesen wird mir
Word.Visible = False markiert

Atrus2711
19.05.2011, 11:16
Lad mal hoch. Ich bin wirklich zu faul, aus den ganzen Angaben eine MDB zusammenzubasteln.

Gold_Phönix
19.05.2011, 11:53
Lad mal hoch. Ich bin wirklich zu faul, aus den ganzen Angaben eine MDB zusammenzubasteln.


Okay

2 Tabellen: tblDateien und Zeichen
1 Formular: Eingabe

Im Formular Eingabe gebe ich die Zeichen ein, mit dem aktuellen Datum werden diese dann in die Tabelle Zeichen eingefügt.
Ich möchte dann ganz gerne, dass wenn ich auf Suchen klicke alle Word-Dokumente aus einem bestimmten Ordner(mit Unterordnern) nach allen Zeichenfolgen in der Tabelle Zeichen durchsucht werden. Sollte eine Zeichenfolge in einem Word-Dokument auftauchen, soll dies in der Tabelle tblDateien reingeschrieben werden
mit der Bezeichnung der Zeichenfolge dem Pfad zur Datei und der Dateiname

mehr wollte ich eigentlich nicht, hätte nicht gedacht das das soviel Aufwand macht.

Hier ist die Testdb: http://www.file-upload.net/download-3442392/Suchdatenbank.zip.html

grzi
19.05.2011, 12:09
Wo ist denn dein Recordset definiert?

Private Sub Befehl4_Click()
...
'Woher kommt dein Recordset?
rs.AddNew
'# Gesuchte Bezeichnung einfügen
rs!Bezeichnung = sSearch
'# Neuen Pfad speichern
rs!DateiPfad = objFld.Path
'# Dateiname speichern
rs!Dateiname = file.Name
rs.Update
...

Wo nichts ist kann auch nichts gemacht werden!

Sorry aber da sträuben sich mir die Haare :entsetzt:

Man sollte schon in etwa wissen was man macht und nicht wild darauf los kopieren und hoffen, dass das irgendwie passt und funktioniert!


Private Sub Befehl4_Click()

'Testdokument durchsuchen

Dim oWord As Word.Application
Dim Doc As Word.Document


Set oWord = CreateObject("Word.application")
Set Doc = Word.Documents.Open("Z:\Newsletter\test.docx")



oWord.Visible = True

MsgBox "Text gefunden: " & SearchWordString("bla", oWord)

Doc.Close

'Wenn deine Schleife spaäter fertig ist:
oWord.Quit


Set oWord = Nothing
Set Doc = Nothing

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

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblDateien", dbOpenDynaset)

rs.AddNew
'# Gesuchte Bezeichnung einfügen
rs!Bezeichnung = sSearch
'# Neuen Pfad speichern
rs!DateiPfad = "Hier musst du deinen Pfad noch eintragen lassen! Wo soll der denn her kommen? objFld.Path"
'# Dateiname speichern
rs!Dateiname = " dementsprechend hier der Dateiname... -> file.Name"
rs.Update
rs.Close
End If
End With 'oWord.selection.Find

Set rs= Nothing
End Function

Habe dir hier für Teil 1 mal eine Grobe Korrektur gemacht - aber mache dir mal ein paar Gedanken wie das weiter gehen soll! ;)

Gold_Phönix
19.05.2011, 12:50
Habe mich jetzt für diesen Code entschieden.
Er durchsucht jetzt alle Dateien fehlerlos und speichert die Ergebnisse ab.
Fehlt jetzt nur noch der Tabellendurchlauf wo alle Zeichen durchgenommen werden.


'###################################
'# 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)
For Each aword In Doc.Content.Words
If aword.Text = "bla" Then
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

End If
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

Atrus2711
19.05.2011, 13:42
Wir waren schon bei einer anderen Funktion, die flexibler war (was z.B. auch silbengetrennte Worte angeht).

Aber egal.

Bau die bisherige Funktion erstmal so um, dass sie nicht fest nach "bla" sucht, sondern den Suchtext übergeben bekommen kann.

Teste das im Direktfenster.

Dann kannst du die Suchworte aus einer Tabelle lesen und in einer Schleife in einem Recordset einzeln an die Funktion geben.

Gold_Phönix
24.05.2011, 08:45
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

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

Gold_Phönix
24.05.2011, 09:52
Wir waren schon bei einer anderen Funktion, die flexibler war (was z.B. auch silbengetrennte Worte angeht).



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:

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



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

Atrus2711
24.05.2011, 11:25
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.05.2011, 11:39
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.05.2011, 13:01
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.05.2011, 13:03
Ne ich möchte ja das das ganze Dokument durchsucht wird. Von A-Z

Atrus2711
24.05.2011, 15:52
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
28.07.2011, 10:15
Danke das funktioniert super :)

qo7300
22.11.2011, 15:41
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
23.11.2011, 10:59
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.11.2011, 11:56
Nach dem Korrigieren der Verweise funktioniert es auch bei mir.

Gruß Uli