I'm trying to replace some placeholder text in a word document using my VB.NET code. Here's the code I'm using:
Dim oWord As Word.Application
Dim aDoc As Word.Document
'Start Word and open the document template.
oWord = CreateObject("Word.Application")
oWord.Visible = True
'Load Invoice Template From Resource File
Dim myTempFile As String = Application.UserAppDataPath & "\mytemp.docx"
My.Computer.FileSystem.WriteAllBytes(myTempFile, My.Resources.InvoiceTemp, False)
aDoc = oWord.Documents.Add(myTempFile, , , True)
oWord.Selection.Find.ClearFormatting()
oWord.Selection.Find.Replacement.ClearFormatting()
With oWord.Selection.Find
.Text = "[iOrder]"
.Replacement.Text = bwOrderID
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWord.Selection.Find.Execute(Replace:=Word.WdReplace.wdReplaceAll)
For Each oCtl As Word.Shape In aDoc.Shapes
If oCtl.Type = Microsoft.Office.Core.MsoShapeType.msoTextBox Then
oCtl.TextFrame.TextRange.Text.Replace("[iOrder]", bwOrderID)
End If
Next
This code executes correctly, with no errors, but it doesn't find "[iOrder]" in the textbox. However, if I then go to the word file and press ctrl + F for find and replace, the search criteria specified in the code is there, if I then click replace, it correctly replaces "[iOrder]" with the bwOrderID string.
I must be missing something here?
Update 1
I've updated my code to:
For Each oCtl As Word.Shape In aDoc.Shapes
If oCtl.Type = Microsoft.Office.Core.MsoShapeType.msoTextBox Then
oCtl.TextFrame.TextRange.Text = "Invoice: " & oCtl.TextFrame.TextRange.Text.Replace("[iOrder]", bwOrderID)
End If
Next
This is working correctly, however I am losing my formatting. Is there a way to keep the formatting? The word "Invoice:" is a different colour to the "[iOrder]" and I'd very much like to keep it like that if possible.
Update 2
I have got the "Find/Replace" working, but I have a formatting issue as a result. Before the Find/Replace, the formatting of the textbox is like this:
Code:
For Each oCtl As Word.Shape In aDoc.Shapes
If oCtl.Type = Microsoft.Office.Core.MsoShapeType.msoTextBox Then
oCtl.TextFrame.TextRange.FormattedText.Text = oCtl.TextFrame.TextRange.FormattedText.Text.Replace("[iOrder]", bwOrderID)
End If
Next
This is what the result is after the above code runs:
I have lost the alignment of the whole string and the color of the [iOrder] section that has been replaced. Is there a way of preserving this formatting?
Related
I have a word document (report) and in that document, I'm importing many text files with fields like this:
{INCLUDETEXT "C:\\PATH\\TOXMLFILES\\Request.xml" \*CHARFORMAT}
Also I'm updating all those fields with a macro on opening the document...
Sub AutoOpen()
With Options
.UpdateFieldsAtPrint = True
.UpdateLinksAtPrint = True
End With
ActiveDocument.Fields.Update
End Sub
Now I need to highlight the text of those imported XMLs (in the IncludeText fields) between <faultstring></faultstring> tags
Here is code I got here on stackoverflow for highlighting text (making it bold)
Sub BoldBetweenQuotes()
' base for a quotes finding macro
Dim blnSearchAgain As Boolean
Dim blnFindStart As Boolean
Dim blnFindEnd As Boolean
Dim rngFind As word.Range
Dim rngFindStart As word.Range
Dim rngFindEnd As word.Range
Set rngFind = ActiveDocument.content
Set rngFindStart = rngFind.Duplicate
Do
' set up find of first of quote pair
With rngFindStart.Find
.ClearFormatting
.Text = "<faultstring>"
.Replacement.Text = ""
.Forward = True
.wrap = wdFindStop
blnFindStart = .Execute
End With
If blnFindStart Then
rngFindStart.Collapse wdCollapseEnd
Set rngFindEnd = rngFindStart.Duplicate
rngFindEnd.Find.Text = "</faultstring>"
blnFindEnd = rngFindEnd.Find.Execute
If blnFindEnd Then
rngFindStart.End = rngFindEnd.Start
' make it bold
rngFindStart.Font.Bold = True
rngFindStart.Start = rngFindEnd.End
rngFindStart.End = rngFind.End
blnSearchAgain = True
Else
blnSearchAgain = False
End If
Else
blnSearchAgain = False
End If
Loop While blnSearchAgain = True
End Sub
Problem is, when I run the macro in my Word document (with the IncludeText fields) it keeps cycling and bolding just the first appearance of text between faultstring tags. When I run it in a new Word document with some random text and faultrstring tags it works well...
EDIT: It turns out the problem is due to the faultstring tags being inside the IncludeText fields. I need to turn the fields into static text after opening the document and updating the fields. How can I do that?
In order to convert dynamic field content to static text using Word's object model (such as VBA) the Fields.Unlink method is required. For the entire document:
ActiveDocument.Fields.Unlink
This is also possible for any given Range; to remove the fields in the last paragraph, for example:
ActiveDocument.Paragraphs.Last.Range.Fields.Unlink
In order to unlink only a certain type of field, loop the Fields collection, test the Field.Type and unlink accordingly. For example, for IncludeText:
Sub DeleteIncludeTextFields()
Dim doc As word.Document
Set doc = ActiveDocument
Debug.Print DeleteFieldType(wdFieldIncludeText, doc)
End Sub
Function DeleteFieldType(fldType As word.WdFieldType, doc As word.Document) _
As Long
Dim fld As word.Field
Dim counter As Long
counter = 0
For Each fld In doc.Fields
If fld.Type = wdFieldIncludeText Then
fld.Unlink
counter = counter + 1
End If
Next
DeleteFieldType = counter
End Function
Assuming you want to do this for all the fields in your document, after updating it:
Sub AutoOpen()
With Options
.UpdateFieldsAtPrint = True
.UpdateLinksAtPrint = True
End With
ActiveDocument.Fields.Update
ActiveDocument.Fields.Unlink
End Sub
I have a VBA Script that finds a named cell in Excel and pastes it in Word based on an identifier that I have in Word. I use RegEx to find the identifier.
The problem that I am experiencing is, whenever it pastes the value (correctly) it "presses Enter" so that it goes to the next line. It should not.
Here is the script:
Dim objWord, objWordDoc, RegEx, objExcel, objWorkbook, content, texts, text, Text_Name
Set RegEx = CreateObject("VBScript.RegExp")
Set objWord = CreateObject("Word.Application")
Set objExcel = CreateObject("Excel.Application")
Set objWordDoc = objWord.Documents.Open("D:\Performance Review Template Rev1.docx", False, True)
Set objWorkbook = objExcel.Workbooks.Open("D:\Template Rev1.xlsm", False, True)
'The entire content of the Word Document
Set content = objWord.ActiveDocument.Content
'The Regular Expression in terms of finding the short code within the document
'Explanation
'-----------
'\[# == Escaped [# characters to indicate that the start of the search needs to be an [#
'(.*?) == The forward seach in a non greedy way that is also the return group
'\] == Escaped ] character that signals the end of the search term
RegEx.Pattern = "\[#(.*?)\]"
RegEx.Global = True
Set texts = RegEx.Execute(content)
Dim Found
For Each text In texts
Set content = objWord.ActiveDocument.Content
'Find the TextName that is in the short code. The Submatches property returns
'the value of the inner return group, whereas the .Value property only returns
'the value of the short code with the [!xxx] added
Text_Name = text.submatches(0)
Dim xName, xText
Found = False
'Search for the text through all the Named Cells in the Excel file
objExcel.Range(Text_Name).Copy
With content.Find
.MatchWholeWord = True
.Text = text.Value
.Execute
If .Found = True Then
Found = True
content.PasteAndFormat 20
End If
End With
If Found = False Then
MsgBox "Did not find Named Cell!"
End If
With content.Find
.Text = text.Value
.Execute
If .Found = True Then
objWord.Selection.Range.Delete
End If
End With
Next
MsgBox "Completed named cells"
objWord.ActiveDocument.Close
objWord.Application.Quit
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
Like always, any help is always appreciated.
This seems to be standard behavior of copy functionality (doing it manually gives same result).
Proposed solution could be to use direct copying of content instead of using copy & paste.
Formatting is also preserved from target document.
Here is tested code (Changes marked with %%%%):
Dim objWord, objWordDoc, RegEx, objExcel, objWorkbook, content, texts, text, Text_Name, copiedText ' %%%% Added variable
Set RegEx = CreateObject("VBScript.RegExp")
Set objWord = CreateObject("Word.Application")
Set objExcel = CreateObject("Excel.Application")
Set objWordDoc = objWord.Documents.Open("D:\Performance Review Template Rev1.docx", False, True)
Set objWorkbook = objExcel.Workbooks.Open("D:\Template Rev1.xlsm", False, True)
'The entire content of the Word Document
Set content = objWord.ActiveDocument.content
'The Regular Expression in terms of finding the short code within the document
'Explanation
'-----------
'\[# == Escaped [# characters to indicate that the start of the search needs to be an [#
'(.*?) == The forward seach in a non greedy way that is also the return group
'\] == Escaped ] character that signals the end of the search term
RegEx.Pattern = "\[#(.*?)\]"
RegEx.Global = True
Set texts = RegEx.Execute(content)
Dim Found
For Each text In texts
Set content = objWord.ActiveDocument.content
'Find the TextName that is in the short code. The Submatches property returns
'the value of the inner return group, whereas the .Value property only returns
'the value of the short code with the [!xxx] added
Text_Name = text.submatches(0)
Dim xName, xText
Found = False
'Search for the text through all the Named Cells in the Excel file
copiedText = objExcel.Range(Text_Name).text ' %%%%
' %%%% Instead of objExcel.Range(Text_Name).Copy
With content.Find
.MatchWholeWord = True
.text = text.Value
.Execute
If .Found = True Then
Found = True
.Parent.text = copiedText ' %%%%
' %%%% Instead of content.PasteAndFormat 20
End If
End With
If Found = False Then
MsgBox "Did not find Named Cell!"
End If
With content.Find
.text = text.Value
.Execute
If .Found = True Then
objWord.Selection.Range.Delete
End If
End With
Next
MsgBox "Completed named cells"
objWord.ActiveDocument.Close
objWord.Application.Quit
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
I trying to replace or search and add hyperlink to specyfy sentence in Word document. I try using this codes. Anyway code is changing only first finding word, not all in document:
Dim r As Word.Range
r = Globals.ThisAddIn.Application.ActiveDocument.Content
With r.Find
.ClearFormatting()
.Text = ("MyWordA MyWordB")
.MatchWholeWord = True
.Forward = True
.Execute()
'If .Found = True Then r.Hyperlinks.Add(r, "http:\\www.whatever", , "Displayed text")
Do While .Execute(Forward:=True) = True
r.Hyperlinks.Add(r, "http:\\www.whatever", , "Displayed text")
'r.Font.ColorIndex = Word.WdColorIndex.wdBlue 'works for all(?)
Loop
End With
Eaven when I want to find only single word in loop for, then code find first one:
doc = Globals.ThisAddIn.Application.ActiveDocument
Dim r As Word.Range = doc.Range
Dim ww As Word.Range
For Each ww In r.Words
If ww.Text = "MyWord" Then _
ww.Hyperlinks.Add(ww, "http:\\www.whatever", , "Displayed text")
Next
Anyone could tell me how I can search all text to replace/add hyperlinks to all text I was looking for?
The problem is that you keep finding the same text over and over again. Within your loop, after adding the hyperlink, you need to move the range after the added hyperlink. The simplest way to do this is to collapse the range by calling
r.Collapse(WdCollapseDirection.wdCollapseEnd)
To troubleshoot issues like this it is helpful to select the current range so that you can see what is going on.
Do While .Execute(Forward:=True) = True
' select range for troubleshooting
r.Select()
r.Hyperlinks.Add(r, "http:\\www.whatever", , "Displayed text")
' move the range after the link
r.Collapse(WdCollapseDirection.wdCollapseEnd)
Loop
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
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