H ey folks,
I need to find a specific string (formatted as heading 1) in a MS Word document via Excel VBA and then set a bookmark at that location. The latter part shouldn't be a problem as soon as I've got the range of the searched string.
However, I can't seem to figure out how to search for a string in Word using Excel VBA.
I tried the following (shortened):
Option Explicit
Sub exportWord(button As IRibbonControl)
Application.ScreenUpdating = False
Dim wrdDoc As Word.document
Dim wrdApp As Word.Application
Dim wrdLoc As String
wrdLoc = ThisWorkbook.Worksheets("Konfiguration").Range("changelogPath")
Set wrdApp = New Word.Application
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(wrdLoc)
Dim wrdRange As Word.Range
Dim searchString As String
Set wrdRange = wrdDoc.Range
searchString = "Test"
With wrdRange.Find
.Text = searchString
.Replacement.Text = "Replacement Test"
.wrap = wdFindContinue
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = False
.Execute Replace:=wdReplaceAll
End With
End Sub
This wouldn't actually do anything, but I just wanted to check of the finding works. It does not though and Excel just crashes without any VBA error or anything. Just says something amont of the lines of "Program not responding, the application has encountered a problem and will be closed down"
Does anyone have an idea why Excel would just crash without any proper error message? Or how to implemented a search in a Word document properly?
best regards,
daZza
Tried something different and solved it with:
For Each rngStory In wrdDoc.StoryRanges
With rngStory.Find
.Replacement.ClearFormatting
.Text = "Änderungen in Test12345"
.Replacement.Text = "test"
.wrap = wdFindContinue
.ExecuteReplace:=wdReplaceAll
End With
Next
Related
I am looking to create a via script in excel that will replace a text holder in a word doc with some text from excel.
I can get the via script to open the word doc, and then save the doc under a new name. however it will not execute the replace text part :(
Private Sub CommandButton1_Click()
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
Set wdDoc = wdApp.Documents.Open("temp.docx")
With wdDoc.Content.Find
.ClearFormatting
.Text = "<<name>>"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Text = "John Smith"
End With
.Execute Replace:=wdReplaceAll
End With
wdDoc.SaveAs2 Filename:=("temp2.docx")
Set wdApp = Nothing
Set wdDoc = Nothing
End Sub
I have tried doing a search in here but can't see where I am going wrong :(
currently it opens the word doc and saves it under a new name but does not replace the find and replace the text. Can anyone see where I have gone wrong and show me how to get it right?
When I set up a test for your problem description in Word, by typing <<name>> I see that Word replaces the two angled brackets with special symbols. And it offers the possibility to undo the AutoCorrect causing this.
Querying ASC(Selection.Text) on them gives Chr(171) and Chr(187), which are also double-angled bracket symbols, but using them in Find does not work. Querying AscW() reveals the two symbols are Unicode 8810 and 8811, so they need to be searched differently.
Assuming that's the issue in your case, the following works:
With wdDoc.content.Find
.ClearFormatting
.Text = ChrW(8810) & "name" & ChrW(8811) '"<<name>>"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Text = "John Smith"
End With
.Execute Replace:=wdReplaceAll
End With
Further to your code - it has other, potentially grave problems (memory leak):
If you do this: wdApp.Visible = False then you need to be absolutely certain to remove Word from memory:
wdDoc.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Unlike Excel, Word won't quit automatically when its object goes out of scope (macro ends). It will stay open, which you can see in the Task Manager.
In addition, you need to release the objects in the reverse order in which they were instantiated - wdDoc before wdApp.
Setup some DocVariables in your Word doc and run the code below, from within Excel.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
'On Error Resume Next
objWord.ActiveDocument.variables("BrokerFirstName").Value = Range("BrokerFirstName").Value
objWord.ActiveDocument.variables("BrokerLastName").Value = Range("BrokerLastName").Value
objWord.ActiveDocument.variables("Ryan").Value = Range("Ryan").Value
objWord.ActiveDocument.Fields.Update
'On Error Resume Next
objWord.Visible = True
End Sub
You can use essentially the same process by setting up Bookmarks in Word, and pushing data from fields in Excel to fields (Bookmarks) in Word.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
On Error Resume Next
ActiveDocument.Variables("BrokerFirstName").Value = Range("B1").Value
ActiveDocument.Variables("BrokerLastName").Value = Range("B2").Value
ActiveDocument.Fields.Update
On Error Resume Next
objWord.Visible = True
End Sub
The famouse hope - to have one button for all live cases with caption: "Make it OK!"
Do divide the task on parts:
- Get "... text from excel ..."
- "replace text in word doc ..." with text getted from Excel on previouse step
Do it by two separate procedures for each of tasks,
called from the third procedure united them.
.
12345qwesdfasdf22232 & 021930
Like the string above, I want to move the cursor to the position after the character & by searching the character in the string. How can I achieve it when I using visual basic to control the word?
Option Explicit
Dim WordApp As Word.Application
Private Sub Command2_Click()
Set WordApp = New Word.Application
WordApp.Documents.Open CommonDialog1.FileName
WordApp.Visible = True
WordApp.DisplayAlerts = False
...
End Sub
If you are outputting using Selection.TypeText, you can use
Selection.MoveStartUntil "&", wdBackward
Selection.MoveLeft 1
which will move you backwards until the first occurrence of the ampersand.
You can also do as Cindy Meister mentioned, do a Selection.Find similar to...
With Selection.Find
.MatchWildCards = false
.Text = "&"
.Execute
End With
I have the most baffling set of errors cropping up in my code. The goal is just to create a Word document from a template, and edit the document using find/replace to fill in some data from excel. Here are the symptoms:
When I run the code the first time, everything works perfectly
The next time I run the code, one of two thing happens depending on what I did before calling it:
If I closed the word document before running the code again, the second time I run it (and every even-numbered run after that) it fails. This happens even if I've closed the userform and reran the code from the VBA editor. I think this has something to do with binding the word objects, but I'm new to VBA and don't see what I've done wrong.
If I didn't close the word document and just press the button again, the code runs and it spawns a new document, but that must not be set to the active document because it just edits the first document I spawned again.
This is the offending code:
Private Sub Generate_Click()
Set wordApp = New Word.Application
wordApp.Visible = True
wordApp.Documents.Add Template:=ThisWorkbook.Path & "\Template.dotx"
FindReplace "[[[DATE_TAG]]]", DateBox.Value
FindReplace "[[[SHIPPING_TAG]]]", POBox.Value
' ... and more of that ...
Set wordApp = Nothing
End Sub
Sub FindReplace(find As String, replace As String)
With Word.ActiveDocument.Range.find ' <---- This line is where the debugger points
' on the 462 error
.Text = find
.Replacement.Text = replace
.Wrap = wdFindContinue
.MatchCase = True
.MatchWholeWord = True
.Forward = True
.Execute replace:=wdReplaceAll
End With
End Sub
In Generate_Click you create an instance of Word referenced by the variable wordApp, but that variable isn't included in the scope of the called Sub FindReplace.
To resolve this you have options:
Create a global variable to reference the Word instance (which would also be accessible to FindReplace) or
Pass an additional parameter to FindReplace via which it can use that Word instance without requiring a Global variable.
Try this instead:
Private Sub Generate_Click()
Dim wdDoc as Word.Document, wordApp As Word.Application
Set wordApp = New Word.Application
wordApp.Visible = True
Set wdDoc = wordApp.Documents.Add(Template:=ThisWorkbook.Path & "\Template.dotx")
FindReplace wdDoc, "[[[DATE_TAG]]]", DateBox.Value
FindReplace wdDoc, "[[[SHIPPING_TAG]]]", POBox.Value
' ... and more of that ...
Set wordApp = Nothing
End Sub
Sub FindReplace(wdDoc as Word.Document, find As String, replace As String)
With wdDoc.Range.find
.Text = find
.Replacement.Text = replace
.Wrap = wdFindContinue
.MatchCase = True
.MatchWholeWord = True
.Forward = True
.Execute replace:=wdReplaceAll
End With
End Sub
I'm working on a Powerpoint slide, where I few texts are listed. I have to search for these texts in a Word Document which has a lot of Headings and Texts. After I find the title text, I need to copy the text under the Heading and paste in a new document.
Basically, the VBA coding has to be done in the Powerpoint VBA, with two documents in the background for searching text and pasting it in another.
I've opened the word doc. But searching the text in it and selecting it for copying to another document is what I've not been able to do. Kindly help me.
I see. The following is not exactly elegant since it uses Selection which I always try to avoid but it is the only way I know to achieve such a thing.
Disclaimer 1: this is made in Word VBA, so you will need a slight adaption, like set a reference to Word, use a wrdApp = New Word.Application object and declare doc and newdoc explicitely as Word.Document.
Disclaimer 2: Since you search for text instead of the respective heading, beware that this will find the first occurence of that text so you better not have the same text in several chapters. ;-)
Disclaimer 3: I cannot paste anymore! :-( My clipboard is set, it pastes elsewhere but I just cannot paste in here.
Code follows with first edit, hopefully in a minute...
Edit: yepp, pasting works again. :-)
Sub FindChapter()
Dim doc As Document, newdoc As Document
Dim startrange As Long, endrange As Long
Dim HeadingToFind As String, ChapterToFind As String
ChapterToFind = "zgasfdiukzfdggsdaf" 'just for testing
Set doc = ActiveDocument
Set newdoc = Documents.Add
doc.Activate
Selection.HomeKey unit:=wdStory
With Selection
With .Find
.ClearFormatting
.Text = ChapterToFind
.MatchWildcards = False
.MatchCase = True
.Execute
End With
If .Find.Found Then
'**********
'Find preceding heading to know where chapter starts
'**********
.Collapse wdCollapseStart
With .Find
.Text = ""
.Style = "Heading 1"
.Forward = False
.Execute
If Not .Found Then
MsgBox "Could not find chapter heading"
Exit Sub
End If
End With
.MoveDown Count:=1
.HomeKey unit:=wdLine
startrange = .Start
'*********
'Find next heading to know where chapter ends
'*********
.Find.Forward = True
.Find.Execute
.Collapse wdCollapseStart
.MoveUp Count:=1
.EndKey unit:=wdLine
endrange = .End
doc.Range(startrange, endrange).Copy
newdoc.Content.Paste
newdoc.SaveAs2 doc.Path & "\" & HeadingToFind & ".docx", wdFormatFlatXML
Else
MsgBox "Chapter not found"
End If
End With
End Sub
Edit: If you need to search for a "feature" that will be in some table in column 1 with the description in column 2 and you need that description in a new doc, try this:
Sub FindFeature()
Dim doc As Document, newdoc As Document
Dim FeatureToFind As String
Dim ro As Long, tbl As Table
FeatureToFind = "zgasfdiukzfdggsdaf" 'just for testing
Set doc = ActiveDocument
Set newdoc = Documents.Add
doc.Activate
Selection.HomeKey unit:=wdStory
With Selection
With .Find
.ClearFormatting
.Text = FeatureToFind
.MatchWildcards = False
.MatchCase = True
.Execute
End With
If .Find.Found Then
Set tbl = Selection.Tables(1)
ro = Selection.Cells(1).RowIndex
tbl.Cell(ro, 2).Range.Copy
newdoc.Range.Paste
End If
End With
End Sub
Edit: Slight adaptation so you can paste without overwriting existing content in newdoc:
Instead of newdoc.Range.Paste just use something along the line of this:
Dim ran As Range
Set ran = newdoc.Range
ran.Start = ran.End
ran.Paste
I have opened the MS word using create object then ,I have to search for a word and replace it with a table.I was able to build a table using VBA.
But, I need to replace that word (Matched) with a Table and later fill the table as per cell.
This is my code:-
Dim MyApp As New Word.Application
Dim MyDoc As Word.Document
Set MyDoc = MyApp.Documents.Add
MyApp.Visible = True
MyDoc.Activate
With ActiveDocument.Content.Find
.Text = "blue"
.Forward = True
.Execute
If .Found = True Then .Parent.Bold = True
End With
MyApp.ActiveDocument.Tables.Add Range:=MyApp.Selection.Range, numrows:=5, numcolumns:=5
MyApp.ActiveDocument.Save
MyApp.Quit
It will help if you do more object-oriented programming, instead of relying on "ActiveDocument", etc.
Start by defining a Range object that represents the Document.Content. The Find.Execute method, if returns True, will redefine this Range object to the found word. So you can use this as the Range argument in the Tables.Add method.
Update from comments I realize that you are instantiating Word, and then adding a new (blank) document. As expected, the Find.Execute will not find anything in this document. Instead, I revised to specifically open a document from a known file path.
'Create a new instance of MS Word
Dim MyApp As New Word.Application
Dim MyDoc As Word.Document
Dim wdRange As Word.Range
'Open an existing Word file:
Set MyDoc = MyApp.Documents.Open("c:\myfile.docx") '# REVISE AS NEEDED
'Make MS Word visible:
MyApp.Visible = True
'Assign the wdRange variable to the document's Content
Set wdRange = MyDoc.Content
'Use the Find method within wdRange:
With wdRange.Find
.Text = "blue"
.Forward = True
.Execute
If .Found = True Then
.Parent.Bold = True
' Since Find.Execute resizes the wdRange to the "found" word, we can
' use this wdRange as the Range argument for Tables.Add:
MyDoc.Tables.Add Range:=wdRange, numrows:=5, numcolumns:=5
End If
End With