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.
.
Related
I have successfully written some VBA code in Excel which opens an existing Word document, finds and replaces a string based on information in the Excel worksheet.
As the source data exists comes from an Access Database, I thought I would try and move the VBA code into Access and run it from there.
The updated code works mostly but strangely, the part of the code which finds and replaces the text string doesn't work when I run it in access.
Sub CreateFormsPDF()
' Creates Garda Vetting Forms NVB1 in Word and saves as PDF
Dim WordApp As Object
Dim WordDoc As Object
Dim db As Database
Dim rs As Recordset
Dim Records As Integer
Dim IDAnchor As String
Dim ID As String
Dim FilePath As String, SaveAsName As String
FilePath = "N:\"
' Start Word and create an object (late binding)
' Document already exists so reference this
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(FilePath & "Form1.docx")
WordApp.Application.Visible = True
' Point to the relevant table in the Current Database
Set db = CurrentDb
Set rs = db.OpenRecordset("qryMailingList", dbOpenDynaset, dbSeeChanges)
Records = rs.RecordCount
' Cycle through all records in MailingList Query
Do Until rs.EOF
' Define IDAnchor
IDAnchor = "$$ID$$"
' Assign current data to variables
ID = rs!StudentID
' Determine the filename
SaveAsName = FilePath & ID & ".pdf"
' Send commands to Word
With WordApp
With WordDoc.Content.Find
.Text = IDAnchor
.Replacement.Text = ID
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
.ActiveDocument.SaveAs2 FileName:=SaveAsName, FileFormat:=17
End With
IDAnchor = ID
rs.MoveNext
Loop
WordApp.Quit savechanges:=wdDoNotSaveChanges
Set WordApp = Nothing
Set WordDoc = Nothing
Set rs = Nothing
Set db = Nothing
MsgBox Records & " Forms Created"
End Sub
The code executes fine, with one exception which is the Find and Replace element in Word i.e.
' Send commands to Word
With WordApp
With WordDoc.Content.Find
.Text = IDAnchor
.Replacement.Text = ID
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
.ActiveDocument.SaveAs2 FileName:=SaveAsName, FileFormat:=17
End With
What is even stranger is that I have a version of this code running via Excel and this runs without any problems at all and I've lifted this section of code from that subroutine exactly as is. So this works in Excel, but not in Access but I've no idea why.
Would really appreciate any help that might be available
Many thanks...
Actually I've just figured it out myself...I hadn't referenced the Word object library under tools.
Always something simple!
I have several word files. They are build like this
text
text
text
Name: Mick
Date: 1-1-1
text
text
Item: Item11 material: Gold
text
text
I am building a macro that can open a word file, put the name in Cell A1 and put the item in Cell A2. I have found a code on internet and adjusted it a little. The following code makes a selection from the beginning of the word doc until a word is found and copies that selection in a given cell.
I hope someone can show me how i can adjust this so the selection begins right before the needed value an stops after it
code below is for item:
Dim wdApp As Object, wdDoc As Object, wdRng As Object
Set wdApp = CreateObject("Word.Application")
With wdApp
.Visible = True
Set wdDoc = .Documents.Open("path", False, True, False)
With wdDoc
Set wdRng = .Range(0, 0)
With .Range
With .Find
.Text = "material"
.Forward = True
.MatchWholeWord = True
.MatchCase = True
.Execute
End With
If .Find.found = True Then
wdRng.End = .Duplicate.Start
Sheets("sheet1").Range("A2").value = wdRng
End If
End With
.Close False
End With
.Quit
End With
Set wdRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing
Anyone any suggestions?
Try the procedure below. It will open the specified Word document, parse the required values via Regular Expressions, place those values into cells A1 and A2, and then close the Word document.
When calling the procedure, specify the full path and filename of the Word document.
For example: SetNameAndItem "C:\Temp\Doc1.docx"
Public Sub SetNameAndItem(strPath As String)
Dim wdApp As Object: Set wdApp = CreateObject("Word.Application")
Dim wdDoc As Object: Set wdDoc = wdApp.Documents.Open(strPath, False, True, False)
Dim objRegEx As Object: Set objRegEx = CreateObject("VBScript.RegExp")
Dim objMatches As Object
On Error GoTo ProcError
With objRegEx
.Global = False
.MultiLine = True
.IgnoreCase = False
.Pattern = "^Name:\s(.*?)$"
End With
Set objMatches = objRegEx.Execute(wdDoc.Content)
If objMatches.Count = 0 Then
Debug.Print "Name: No match."
Else
Range("A1").Value = objMatches(0).SubMatches(0)
End If
objRegEx.Pattern = "^Item:\s(.*?)\smaterial"
Set objMatches = objRegEx.Execute(wdDoc.Content)
If objMatches.Count = 0 Then
Debug.Print "Item: No match."
Else
Range("A2").Value = objMatches(0).SubMatches(0)
End If
ProcExit:
On Error Resume Next
wdDoc.Close False
wdApp.Quit
Set objMatches = Nothing
Set objRegEx = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Exit Sub
ProcError:
MsgBox "Error# " & Err.Number & vbCrLf & Err.Description, , "SetNameAndItem"
Resume ProcExit
End Sub
Result:
Note: Please ensure that the line breaks in your Word document consist of the normal Carriage Return / Line Feed character combination (the results of pressing pressing the Enter key). When I copied/pasted the text from your Question, the document looked as expected, but what appeared to be line feeds were actually Vertical Tab characters, so the Regular Expressions did not work. I'm not saying there was any error on your part, it's probably an artifact of pasting text the web page. Just something to be aware of.
UPDATE:
If the Regular Expressions in the above code don't work, then perhaps it was not a copy/paste issue after all, and you really do have Vertical Tab characters in your document. If that's the case, try modifying the SetNameAndItem procedure in the Excel VBA code as follows.
Replace these two lines (which use ^ and $ to represent start and end of line, respectively):
.Pattern = "^Name:\s(.*?)$"
objRegEx.Pattern = "^Item:\s(.*?)\smaterial"
With these two lines (which use \v to represent vertical tab):
.Pattern = "\vName:\s(.*?)\v"
objRegEx.Pattern = "\vItem:\s(.*?)\smaterial"
Here is a possible solution of your problem:
Use this function to read the word file:
Option Explicit
Public Function f_my_story() as string
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.Application")
With wdApp
.Visible = True
Set wdDoc = .Documents.Open("C:\Users\v\Desktop\text.docx", False, True, False)
f_my_story = wdDoc.Range(0, wdDoc.Range.End)
wdDoc.Close False
.Quit
End With
End Function
Once you have read the file, you get a string. Now you need a macro, which separates the string by space and it returns the values, that are after the values you are looking for.
You can write those values anywhere you want.
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
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
Can any one please tell, How to find a specific word in a word document and paste a word near to that using vba code?
I have already opened the document.So i just want to find the word and paste a word near to that. I have done this using movedown and moveright methods to go to that specific word.But it is more dependent on the position of cursor.
Thanks,
Bharathi
I use this in access I don't know if it will work for you.
Dim mWord As Word.Application
Dim mDoc As Word.Document
Dim mRange As Word.Range
Set mDoc = mWord.Documents.Open("YourPath")
mDoc.SaveAs "Where you want to save"
Set mWord = New Word.Application
mWord.Visible = False
DoEvents
Set mRange = mWord.ActiveDocument.Content
mRange.Find.Execute FindText:=TextToFind1, ReplaceWith:=TextToFind1 & TextToReplace1, Replace:=wdReplaceAll
mRange.Find.Execute FindText:="TextToFind2", ReplaceWith:="TextToReplace2", Replace:=wdReplaceAll
Set mRange = Nothing
mDoc.Save
'Display
mWord.Visible = True
Shell "Explorer.exe /n,/e," & "DirectoryToOpen", vbNormalFocus
Good luck