Add not replace content in Word Content Control using VBA - vba

I am trying to generate multiple Word documents which have content controls that are populated from an Excel file. The second content control needs to be populated with a list which varies in length.
How do I add each value to the content control instead of replacing the current value? I am currently using Rich Text Content Controls.
Here is what I have so far:
Sub CreateCoverLetters()
Dim objWord As Word.Application
Dim wDoc As Word.Document
Dim Rows As Integer
Set objWord = CreateObject(Class:="Word.Application")
objWord.Visible = True
Set wDoc = objWord.Documents.Open(*insert filepath*)
objWord.Activate
wDoc.ContentControls(1).Range.Text = Worksheets("Lists").Range("A2").Value
Rows = Worksheets("Lists").Range("A3", Range("A3").End(xlDown)).Rows.Count
r = 3
For i = 1 To Rows
wDoc.ContentControls(2).Range.Text = Worksheets("Lists").Cells(r, 1).Value
r = r + 1
Next
wDoc.SaveAs (*insert filepath*)
End Sub
Any help much appreciated!

Solved it as follows:
Sub CreateCoverLetters()
Dim objWord As Word.Application
Dim wDoc As Word.Document
Dim Rows As Integer
Dim Content As String
Set objWord = CreateObject(Class:="Word.Application")
objWord.Visible = True
Set wDoc = objWord.Documents.Open(*insert filepath*)
objWord.Activate
wDoc.ContentControls(1).Range.Text = Worksheets("Lists").Range("A2").Value
Rows = Worksheets("Lists").Range("A3", Range("A3").End(xlDown)).Rows.Count
r = 3
For i = 1 To Rows
Content = Content & "- " & Worksheets("Lists").Cells(r, 1).Value & vbNewLine
r = r + 1
Next
wDoc.ContentControls(2).Range.Text = Content
wDoc.SaveAs (*insert filepath*)
End Sub

The approach in user's answer works if the content can 1) be concatenated in a single string and 2) none of the elements require special formatting. This would also be the fastest approach.
If for any reason this process is not possible, then the way to "append" content without replacing goes something like in the code snippet that follows.
Notice how Range and ContentControl objects are declared and instantiated, especially the Range object. This makes it much easier to pick up the "target" at a later point in the code. Also, a Range object can be collapsed (think of it like pressing the right-arrow to make a selection a blinking cursor): this makes it possible to append content and work with that new content (format it, for example). Word also has a Range.InsertAfter method which can be used if the new content does not have to be manipulated in any special way.
Dim cc as Object ' Word.ContentControl
Dim rngCC as Object 'Word.Range
Set cc = wDoc.ContentControls(1).Range
Set rngCC = cc.Range
rngCC.Text = Worksheets("Lists").Range("A2").Value
'Add something at a later point
rngCC.Collapse wdCollapseEnd
rngCC.Text = " New material at the end of the content control."

Related

How do I use VBA to Duplicate an Entire Section in MS Word and Paste it to an Added Section

I have a specified Word Table in my Word document. I want to add a new Section immediately after the Section that contains the source Table, then paste the entire contents of the source Section into the newly added section.
Below is my attempt to code this, but I am open to completely different code that achieves the objective.
My attempt was a function that took the Table as an argument and returns the newly added section. This code worked on the first call, but on the following call it failed to paste with a Run-Time error.
Function CopySection(wdSourceTable As Word.Table) As Word.Section
'Create a new Section after the input Section
Dim lNdxSource As Long
Dim wdRange As Word.Range
Dim wdDoc As Word.Document
Dim wdSourceSection As Word.Section, wdSection As Word.Section
Set wdDoc = wdSourceTable.Parent
Set wdRange = wdSourceTable.Range
'--get section object that contains source table
For Each wdSection In wdDoc.Sections
If wdRange.Start >= wdSection.Range.Start And wdRange.End <= wdSection.Range.End Then
Set wdSourceSection = wdSection
End If
Next wdSection
If Not wdSourceSection Is Nothing Then
lNdxSource = wdSourceSection.Index
'--Add a new section after the source section
wdDoc.Sections.Add (wdDoc.Sections(lNdxSource + 1))
'--Copy the contents of the source section to the new section
wdSourceSection.Range.copy
' on second call of this function, throws Run-time error '4198' Command failed
wdDoc.Sections(lNdxSource + 1).Range.Paste
End If
ExitProc:
Set CopySection = wdDoc.Sections(lNdxSource + 1)
End Function
I'm running the code from Excel with early binding to the Word library.
There is no need to use the clipboard. You can use the FormattedText property instead. Also, as the Sections.Add method returns a Section object you don't need to use the index to get the new section.
Function CopySection(wdSourceTable As Word.Table) As Word.Section
'Create a new Section after the input Section
Dim lNdxSource As Long
Dim wdRange As Word.Range
Dim wdDoc As Word.Document
Dim wdSourceSection As Word.Section, wdSection As Word.Section, wdNewSection As Section
Set wdDoc = wdSourceTable.Parent
Set wdRange = wdSourceTable.Range
'--get section object that contains source table
For Each wdSection In wdDoc.Sections
If wdRange.Start >= wdSection.Range.Start And wdRange.End <= wdSection.Range.End Then
Set wdSourceSection = wdSection
End If
Next wdSection
If Not wdSourceSection Is Nothing Then
lNdxSource = wdSourceSection.Index
'--Add a new section after the source section
Set wdNewSection = wdDoc.Sections.Add(wdDoc.Sections(lNdxSource + 1).Range)
'--Copy the content to the new section
wdNewSection.Range.FormattedText = wdSourceSection.Range.FormattedText
End If
ExitProc:
Set CopySection = wdNewSection
End Function

How to fill multiple Bookmarks / FormFields in Word from the same field in Access using VBA

I had previously been using some VBA to pass fields from Access into a Word document, until coming up against the 255 character limit. Assistance from this site has led me to now use Bookmarks instead of Form Fields.
I was originally filling many different fields on Word and in some instances using the same data from Access in two places on the Word document. I was achieving this by calling:
.FormFields("txtReasonforReward").Result = Me![Reason for Reward]
.FormFields("txtReasonforReward2").Result = Me![Reason for Reward]
As I now have a different way of filling the "Reason for Reward" box, to circumvent the character limit (code below), I'm not sure how to fill "txtReasonforReward2". I do have several instances where I've added a second field and stuck a 2 on the end... I'm not convinced this is the best way so if anybody can advise on how to achieve this with both FormFields and Bookmarks, I'd be really grateful.
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set doc = objWord.Documents.Open(***path to file***, , True)
Dim rng As Word.Range
Dim x As String
With doc
.FormFields("txtFirstName").Result = Me![First Name]
.FormFields("txtLastName").Result = Me![Last Name]
`examples cut for clarity...
.FormFields("txtHRID").Result = Me![ID]
.FormFields("txtPeriod").Result = Me![Period]
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
Set rng = doc.Bookmarks("txtReasonforReward").Range
rng.MoveStart wdCharacter, -1
x = rng.Characters.First
rng.FormFields(1).Delete
rng.Text = x & Me![Reason for Reward]
doc.Protect wdAllowOnlyFormFields, True
.Visible = True
.Activate
End With
objWord.View.ReadingLayout = True
Building on the code in the question and the background question...
Word can duplicate the content of a bookmark using REF field codes. Since form fields also use bookmark identifiers, this will work with existing form fields as well as bookmarked content. REF fields can be inserted directly, if a person is familiar with doing so OR by inserting a cross-reference to the bookmark.
Referring to the work-around for inserting more than 255 characters, in this case it will be necessary to also place a bookmark around the range being inserted and to update the REF fields so that they mirror the bookmark content throughout the document. The modified section of code is below.
'Declarations to be added at the beginning of the procedure
Dim fld As Word.Field
Dim bkmName As String
'Name of form field, bookmark to be added and text in REF field code
bkmName = "txtReasonforReward"
'Existing code
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
Set rng = doc.Bookmarks(bkmName).Range
rng.MoveStart wdCharacter, -1
x = rng.Characters.First
rng.FormFields(1).Delete
rng.Text = x & Me![Reason for Reward]
' New code
'Leave that single character out of the range for the bookmark
rng.MoveStart wdCharacter, 1
'Bookmark the inserted content
doc.Bookmarks.Add bkmName, rng
'Update fields so that REF's pick up the bookmark content
For Each fld In doc.Fields
If fld.Type = wdFieldRef Then
fld.Update
End If
Next
doc.Protect wdAllowOnlyFormFields, True
This approach will get a bit unwieldy if it needs to be applied to many fields. It might make sense to do something like write the bookmark names to a Tag property of the controls in the Access form then loop the controls to pick up bookmark name and data from the control, rather than writing each out explicitly - but this is just a thought for the future.
All that being said, the "modern" way to achieve this is to work with content controls instead of form fields/bookmarks. Content controls do not have the 255 character limit, the document can be protected as a form, multiple content controls can have the same title (name) and/or tag. Furthermore, content controls can be "mapped" to a Custom XML Part stored in the document so that changing the content of one will change the content of another. Trying to describe all that would go beyond what should be in an "answer", here, but is all publicly available by searching the Internet.
Personally, if this were my project and knowing what I know of it: If form fields are not required in the document (no user input via the fields is expected) I would use bookmarks and REF fields, only.
There are so may ways to do this kind of thing. Take a look at the approach below and see if you can get it to work.
Option Compare Database
' This concept uses Docvariables in MS Word
Sub PushToWord()
Dim wapp As Word.Application
Dim wdoc As Word.Document
Dim db As DAO.Database
Dim fld As DAO.Field
Dim rs As DAO.Recordset
Dim filenm As String
Dim NumFields As Integer
Dim i As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_CustomerData")
Set wapp = New Word.Application
wapp.Visible = True
Set rs = DBEngine(0)(0).OpenRecordset("SELECT * FROM tbl_CustomerData")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
Set fld = rs.Fields(i)
Debug.Print fld.Name, fld.Value
If fld.Value = 20 Then
filenm = "C:\Users\Ryan\Desktop\Coding\Integrating Access and Word\From Access to Word\Letter1.doc"
Set wdoc = wapp.Documents.Open(filenm)
wapp.ActiveDocument.Variables("Name").Value = rs.Fields("Name").Value
End If
Next
rs.MoveNext
Loop
Set fld = Nothing
rs.Close
End If
Set rs = Nothing
End Sub
The code runs from Access, and you can fire it off any number of ways (button click event, form load event, some other object event, etc.)

Excel VBA code for searching PDF in Adobe Acrobat

I want to search a PDF file for a string and print the number of counted instances. I've done this for Word, Excel, and Powerpoint, but never Acrobat. There is an error when I call acroDoc.Range, so I assume this is the wrong syntax for Acrobat.
Run-time error '450': Wrong number of arguments or invalid property assignment.
I can't find answers in Adobe's documentation. What is the correct syntax for selecting the whole document and searching for a string?
Sub pdfSearch()
Dim acroApp As Object
Dim acroDoc As Object
Dim aRng As Object
Dim i As Integer
i = 0
Set acroApp = CreateObject("AcroExch.App")
Set acroDoc = CreateObject("AcroExch.pddoc")
acroDoc.Open ("C:\Documents\example.pdf")
Set aRng = acroDoc.Range
With aRng.Find
Do While .Execute(FindText:="desk", MatchCase:=False)
i = i + 1
Loop
End With
acroDoc.Close 0
Set aRng = Nothing
Set acroDoc = Nothing
Set acroApp = Nothing
Debug.Print (i)
End Sub
Acrobat doesn't have a concept of Range. FindText finds the specified text, scrolls so that it is visible, and highlights it. The return value is -1 when the text is found. Unless you also pass a parameter to reset the selection, subsequent calls will start where you left off so to get the count, you just loop until the return value is something other than -1. I haven't used VAB in quite a while but I think the code would look like this...
i = 0
Set acroApp = CreateObject("AcroExch.App")
Set acroDoc = CreateObject("AcroExch.AVDoc")
acroDoc.Open ("C:\Documents\example.pdf")
Do While acroDoc.FindText("desk",0) == -1
i = i + 1
Loop
Documentation to FindText:
http://help.adobe.com/en_US/acrobat/acrobat_dc_sdk/2015/HTMLHelp/index.html#t=Acro12_MasterBook%2FIAC_API_OLE_Objects%2FFindText.htm

VBA - Extract form fields from a word doc that has been saved as a pdf

My company has a word document form that is filled in by customers containing their feedback on our service.
Data from these forms are extracted from the word document and dumped into excel using the following VBA...this works fine.
Dim Val As String
Dim WrdDoc As Document
Dim FormFieldCounter As Integer
Dim TotalFormFields As Integer
Set wordapp = CreateObject("word.Application")
wordapp.Documents.Open filename:=filenme, ReadOnly:=True
wordapp.ScreenUpdating = False
Set WrdDoc = wordapp.Documents(filenme)
wordapp.Visible = True
Dim version As String
version = WrdDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text
FormFieldCounter = 1
RowCounter = RowCounter + 1
TotalFormFields = WrdDoc.FormFields.Count
Do While FormFieldCounter <= TotalFormFields
WrdDoc.FormFields(FormFieldCounter).Select
Val = WrdDoc.FormFields(FormFieldCounter).result
Sheets("Sheet 1").Cells(RowCounter, FormFieldCounter) = Val
FormFieldCounter = FormFieldCounter + 1
Loop
wordapp.Documents(filenme).Close SaveChanges:=wdDoNotSaveChanges
wordapp.Quit
Quite a lot of the time customers return the MS-Word feedback forms saved as PDFs and the above method obviously doesnt work for these.
As the customers have created these PDF files themselves and it is a not a form created in Adobe Acrobat, I don't know which method to use to extract the data or know if it is even possible.
Any thoughts would be greatly appreciated

Step through a word table selection with VBA

I've been trying to write a Macro that changes some formatting in big tables in Word for me. I tried to find this information, but as soon as there are tables, the information is for excel.
So the situation I got is this, I got a table with 6 columns. The first two columns will get selected, the Macro started. Now I'd like it to read the first cell of the selection from the top left, then I do some manipulation/calculations with it, then I'd like to write back the manipulated data, move on to the cell to the right, read the data, manipulate it, write back something and then do so till the end of the Selection.
Can someone help me with a code skeleton? That would be awesome!
Here's a possible skeleton, it loops through columns 1 and 2 of a preexisting table.
Sub TestTable()
Dim wordApp As Word.Application
Dim docDocument As Word.Document
Dim tblTable As Word.Table
Dim c As Word.Cell
Dim sString As String
Dim iColumnNumber As Integer
Set wordApp = CreateObject("Word.Application")
Set docDocument = wordApp.Documents.Open("<location of your document e.g. C:\MyDoc.doc>")
Set tblTable = docDocument.Tables(1)
For iColumnNumber = 1 To 2
For Each c In tblTable.Columns(1).Cells
sString = c.Range.Text
'Do something
Next c
Next iColumnNumber
'wordApp.Visible = True
Set tblTable = Nothing
Set docDocument = Nothing
Set wordApp = Nothing
End Sub