I'd like find text in Microsoft Word and get adjacent words.
I would like to start with a word and find all the words before and after they surround it.
The function should be recursive.
For Example:
abc def ghi jkl mno def pqr stu wxy def
if i search the string "def", the function should return me:
abc def ghi mno def pqr wxy def
it's possible?
thank you!
Sub Cerca(Parola)
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim Prima As Integer
Dim Dopo As Integer
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = Parola
' .Replacement.Text = "Provo"
.Forward = True
.Wrap = wdFindStop
Do While .Execute() = True
Selection.MoveRight Unit:=wdWord, Count:=4
Set rng2 = Selection.Range
Selection.MoveLeft Unit:=wdWord, Count:=9
Set rng1 = Selection.Range
Prima = rng1.Start
Dopo = rng2.Start
Set rngFound = ActiveDocument.Range(Prima, Dopo)
strTheText = rngFound.Text
ScriviFile Parola & Chr(9) & strTheText
'Selection.Find.Replacement.Font.Italic = True
'Selection.Font.Bold = True
'Selection.MoveRight Unit:=wdCharacter, Count:=Dopo
' Selection.MoveRight Unit:=wdWord, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=9
Loop
End With
End Sub
The procedure I published does not work well because it also considers punctuation as words.
I try to explain myself better... i'd like a function that search in a Microsoft Word document a string and get me a number "x" of words before and next the string i have passed. For Example....
function myGetMyListOfSearch(SearchString as string, PreviusWord as integer, NextWord as integer)
This function return me a list of "strings" with my "SearchString" surrounded by the terms on the left and right of it...
it's possible?
A wildcard Find with:
Find = <[! ]@>[,. ^t^l^13]@Parola[,. ^t^l^13]@<[! ]@>
should suffice, even where the preceding/next word is in a different paragraph.
I am not proud of this solution ....
I look for a string in a word document and publish the result in a table of another word document ... The table is divided into 3 parts: in the center the string I searched for, in the first column "x number of words" to the left of the string and in the third column "y number of words" to the right of the searched string. But it's very slow ... better solutions? Thank you
Sub Cerca(Parola, Destinazione)
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim Prima As Long
Dim Dopo As Long
Dim PosizioneAttuale As Long
Dim strSinistra As String
Dim strCentro As String
Dim strDestra As String
Dim UltimaRiga As Long
Dim Ciclo As Long
Dim Sicurezza As Long
Selection.HomeKey Unit:=wdStory
'Selection.Find.ClearFormatting
With Selection.Find
.Text = Parola
' .Replacement.Text = "Provo"
.Forward = True
.Wrap = wdFindStop
.IgnorePunct = True
.MatchWholeWord = ParoleIntere
.ClearFormatting
.Format = False
Do While .Execute() = True
DoEvents
PosizioneAttuale = Selection.Start
'SI CONTROLLA A DESTRA
Ciclo = 0
Sicurezza = 0
Do
'DoEvents
Sicurezza = Sicurezza + 1
Selection.MoveRight Unit:=wdWord, Count:=1
If InStr(1, ".,;:-_/!\'()" & Chr(34) & vbCrLf, Trim(Selection.Range.Words.Item(1)), vbTextCompare) = 0 Then
Ciclo = Ciclo + 1
End If
If Sicurezza > 100 Then
'Debug.Print "esco con exit do"
'Selection.MoveLeft Unit:=wdWord, Count:=501
Exit Do 'nel caso entri in loop per qualche motivo
End If
Loop Until Ciclo = ParoleDopo Or Selection.Range.Start = ActiveDocument.Range.End
Selection.MoveRight Unit:=wdWord, Count:=1
Set rng2 = Selection.Range
Selection.Start = PosizioneAttuale
'SI CONTROLLA A SINISTRA
Ciclo = 0
Sicurezza = 0
Selection.MoveLeft Unit:=wdWord, Count:=1
Do
'DoEvents
Sicurezza = Sicurezza + 1
Selection.MoveLeft Unit:=wdWord, Count:=1
If InStr(1, ".,;:-_/!\'()", Trim(Selection.Range.Words.Item(1)), vbTextCompare) = 0 Then
Ciclo = Ciclo + 1
End If
If Sicurezza > 100 Then
Debug.Print "esco con exit do"
'Selection.MoveRight Unit:=wdWord, Count:=501
Exit Do 'nel caso entri in loop per qualche motivo
End If
Loop Until Ciclo = ParolePrima Or Selection.Range.Start = ActiveDocument.Range.End
'Selection.MoveLeft Unit:=wdWord, Count:=ParolePrima + 1
Set rng1 = Selection.Range
Prima = rng1.Start
Dopo = rng2.Start
If Dopo > Prima Then
Set rngFound = ActiveDocument.Range(Prima, Dopo)
strTheText = rngFound.Text
'ScriviFile Left(strTheText, Prima) & Chr(9) & Parola & Chr(9) & Mid(strTheText, Dopo)
strSinistra = Left(strTheText, PosizioneAttuale - Prima)
strCentro = Parola
Prima = PosizioneAttuale + Len(Parola)
If Prima = -1 Then Prima = 0
strDestra = Right(strTheText, Dopo - Prima)
Selection.Start = PosizioneAttuale
Selection.MoveRight Unit:=wdWord, Count:=1
'scrivo nella tabella del foglio destinazione
Documents(Destinazione).Tables(1).Rows.Add
UltimaRiga = Documents(Destinazione).Tables(1).Rows.Count
Documents(Destinazione).Tables(1).Cell(UltimaRiga, 1).Range.InsertAfter strSinistra
Documents(Destinazione).Tables(1).Cell(UltimaRiga, 2).Range.InsertAfter strCentro
Documents(Destinazione).Tables(1).Cell(UltimaRiga, 3).Range.InsertAfter strDestra
End If
Loop
End With
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.