I have placed a Plain Text Content Control on my Document.
I opened the Macro and have the following code
Sub PrefillDocument()
'
' PrefillDocument Macro
'
'
Dim docName As ContentControls
Dim objExcel As Object
Dim FileName As String
FileName = ActiveDocument.Path & "\CountyData.xlsx"
Set objExcel = CreateObject("Excel.Application")
Set exWb = objExcel.Workbooks.Open(FileName)
MsgBox exWb.Sheets("4").Cells(1, 2) // Works
' Having problems trying to get the data from Excel into the content control
Set docName = ActiveDocument.SelectContentControlsByTag("Name") // Get
docName.Item.Title = exWb.Sheets("4").Cells(1, 2)
MsgBox docName.Title
'ActiveDocument.FormFields("Name").Result =
'ThisDocument.m_name.Caption = exWb.Sheets("Member's Data").Cells(2, 1)
exWb.Close
Set exWb = Nothing
End Sub
I have been told NOT to use any legacy controls so I am forced to use the newer ContentControls
docName is a collection of controls, and in this case, Word isn't going to let you apply a Title to every control in the Collection.
So you will need to iterate, e.g.
Dim cc as ContentControl
For Each cc In docName
cc.Title = exWb.Sheets("4").Cells(1, 2)
Next
or you could probably drop your docName declaration and do
Dim cc as ContentControl
For Each cc In ActiveDocument.SelectContentControlsByTag("Name")
cc.Title = exWb.Sheets("4").Cells(1, 2)
Next
For the question you posted in the comments, to update the actual content of the Control rather than the title, you need to know that the content is represented by a Word Range, and that you need to set the text of the range, e.g.
cc.Range.Text = exWb.Sheets("4").Cells(1.2)
You will still need to iterate through the collection of controls.
Related
I have a set of word documents that I want to auto-fill for different clients and I am trying to write a VBA application to accomplish that. I have information about the client, such as today's date and their name, stored in an Excel sheet, and I want to copy that information on multiple Word documents with labels on them. The goal is for every new client, the user would only need to update the client information on the Excel sheet to auto-fill the Word documents.
The below code is what I have right now. objDocument represents the Word document that I am trying to fill in and exWb is the Excel sheet in which I am trying to copy client information from. The Excel sheet has cells named TodayDate and ClientName which stores the respective client information. The Word document has ActiveX control labels named TodayDate, ClientName, and ClientName1 which will be filled in with the corresponding information from the Excel Sheet. ClientName and ClientName1 both contain the information from the "ClientName" cell, but because I cannot have 2 labels of the same name in Word, they are named as such.
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
On Error Resume Next
objDocument.TodayDate.Caption = exWb.Sheets("Sheet1").Range("TodayDate").Value
On Error Resume Next
objDocument.ClientName.Caption = exWb.Sheets("Sheet1").Range("ClientName").Value
On Error Resume Next
objDocument.ClientName1.Caption = exWb.Sheets("Sheet1").Range("ClientName").Value
On Error Resume Next
To make the code more readable, I would like to format it into a for loop, but I am not sure how to declare a variable that can refer to the names of Word document labels in a for loop. I was thinking of using arrays to store the names of Word labels and Excel cells and loop through the list. I suppose it would look something like this:
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
WordLabelList = [TodayDate, ClientName, ClientName1]
ExcelNames = ["TodayDate", "ClientName", "ClientName"]
Dim i as Integer
for i in range(1, length(WordLabelList))
On Error Resume Next
objDocument.WordLabelList[i].Caption = exWb.Sheets("Sheet1").Range(ExcelNames[i]).Value
Next
Or to make it even better, use a dictionary with ExcelNames as the key and WordLabelList as the values so that I do not have to repeat values in the ExcelNames array:
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
ClientInfo = {"TodayDate":[TodayDate], "ClientName": [ClientName, ClientName1]}
for info in ClientInfo
for label in ClientInfo[info].value
On Error Resume Next
objDocument.label.Caption = exWb.Sheets("Sheet1").Range(info).Value
Next
Please let me know how I can achieve any of the above with proper VBA syntax or if you have a more efficient suggestion that is better than re-writing multiple lines in original code.
The only thing you're missing seem to be a way to address an ActiveX control by its name? Once you have that your code gets much simpler.
For example:
Sub Tester()
Dim doc As Object, lbl As Object, nm
Set doc = ThisDocument
For Each nm In Array("TodayDate", "ClientName")
Set lbl = DocActiveX(doc, nm) 'get a reference to an embedded ActiveX control
If Not lbl Is Nothing Then
lbl.Caption = "this is - " & nm
Else
Debug.Print "Control '" & nm & "' not found"
End If
Next nm
End Sub
'return a reference to a named ActiveX control in document `doc`
' (or Nothing if not found)
Function DocActiveX(doc As Document, xName) As Object
Dim obj As Object
On Error Resume Next
Set obj = CallByName(doc, xName, VbGet)
On Error GoTo 0
Set DocActiveX = obj
End Function
I am trying to insert a list of email addresses from Excel into a contact group in Outlook.
I found Excel VBA code online. It uses early binding. It is not an option to force the user to go into Tools-> References -> Outlook, when they open the file.
I need to transform the code from early to late binding.
Questions:
I understand that I need to change Outlook.Application to
CreateObject('Outlook.Application') and that I can access
olFolderContacts with the number 10 instead. See code below.
I can't figure out how to access the remaining items such as
CreateItem(olDistributionListItem).
Sub CreateContactGroupfromExcel()
Dim objContactsFolder As Outlook.Folder
Dim objContact As Outlook.ContactItem
Dim objContactGroup As Outlook.DistListItem
Dim objNameCell As Excel.Range
Dim objEmailCell As Excel.Range
Dim strName As String
Dim strEmail As String
Dim objTempMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Set objContactsFolder = Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
Set objContactGroup = Outlook.Application.CreateItem(olDistributionListItem)
'You can change the contact group name
objContactGroup.DLName = "PlaceHolder_VBA"
i = 0
Do While Range("vba_email_outlook").Offset(i, 0).Value <> "":
strName = Range("vba_name_outlook").Offset(i, 0).Value
strEmail = Range("vba_email_outlook").Offset(i, 0).Value
Set objContact = objContactsFolder.Items.Find("[FullName] = '" & strName & "'")
'If there is no such a contact, create it.
If objContact Is Nothing Then
Set objContact = Outlook.Application.CreateItem(olContactItem)
With objContact
.FullName = strName
.Email1Address = strEmail
.Save
End With
End If
'Add the contacts to the new contact group
Set objTempMail = Outlook.CreateItem(olMailItem)
objTempMail.Recipients.Add (strName)
Set objRecipients = objTempMail.Recipients
objContactGroup.AddMembers objRecipients
i = i + 1
Loop
'Use "objContactGroup.Save" to straightly save it
objContactGroup.Display
objTempMail.Close olDiscard
End Sub
Declare object variables as generic Object
Dim objContactsFolder As Object
Determine number values of constants. With early binding, these values can be seen when hovering over constant or in VBA immediate window: ?olMailItem. Then reference number in place of constant or leave constants referenced as they are and declare them as constants with Const statements. Const olMailItem = 0
olFolderContacts = 10
olMailItem = 0
olDistributionListItem = 7
I am not an expert but this code allows you to add the reference when you run the VBA script, but it will mean that if it errors out the code quits running you will not be able to debug.
On Error Resume Next ''' If reference already exist this would cause an error
Application.VBE.ActiveVBProject.References.AddFromFile ("C:\Program Files (x86)\Microsoft Office\Office16\MSOUTL.OLB") ''' Might have to change file path
On Error GoTo 0
Using MS Word (in my case 2010 version), I have constructed a form with Content Control elements to be filled out by the user. Now I want certain entries (that I already gave titles to) be shown in a chart inside the same Word document (not in a separate Excel document).
This should be an automated process, so that if the user changes one of the Content Control entries, the chart updates itself automatically; I would also be OK if the user had to press a button in order to update the chart (but the user shouldn't have to click around a lot, since I must assume the user to have little skills.)
So I inserted an Excel chart object in my Word form document. I also wrote some VBA code inside this Excel object to read the Content Control values from the Word document as source for the chart. But I think what I really need is the VBA code to be in my Word document itself (for example to be executed upon click on a button by the user), yet I don't know how to address the Excel chart object and the cells within.
My VBA code inside the Excel object is:
Sub ChartDataAcquirer()
Dim wdApp As Object
Dim wdDoc As Object
Dim DocName As String
Dim ccX As String
Dim ccY As String
Dim datapairs As Integer
'''''''''' Variables '''''''''
DocName = "wordform.docm"
ccX = "titleX"
ccY = "titleY"
datapairs = 5
''''''''''''''''''''''''''''''
Set wdApp = GetObject(, "Word.Application")
Set wdDoc = wdApp.Documents(DocName)
Dim i As Integer
For i = 1 To datapairs
With ActiveSheet.Cells(i + 1, 1) ' The first row contains headline, therefore i+1
.Value = wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text ' The CC objects containing the x values have titles "titleX1", "titleX2" ..., therefore "ccX & i"
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text) ' To transform text into numbers, if user filled the CC object with numbers (which he should do)
End With
With ActiveSheet.Cells(i + 1, 2)
.Value = wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text)
End With
Next
End Sub
I guess I need a similar code that is placed in and operates from the Word form document itself, but that is where I am stuck...
The following is demo code that shows how to access an embedded Excel chart.
Note that the Name (Shapes([indexValue])) of your chart Shape is probably different than in this code. You'll need to check and change that assignment. Also, your chart may be an InlineShape rather than a Shape, so you may need to adjust that bit, as well.
This code checks whether the Shape is actually a chart. If it is, the Chart object is accessed as well as its data sheet. Via that, it's possible to get the actual workbook, the worksheets, even the Excel application if you should need it.
Sub EditChartData()
Dim doc As Word.Document
Dim shp As Word.Shape
Dim cht As Word.Chart
Dim wb As Excel.Workbook, ws As Excel.Worksheet, xlApp As Excel.Application
Set doc = ActiveDocument
Set shp = doc.Shapes("MyChart")
If shp.HasChart Then
Set cht = shp.Chart
cht.ChartData.Activate
Set wb = cht.ChartData.Workbook
Set xlApp = wb.Application
Set ws = wb.ActiveSheet
Debug.Print ws.Cells(1, 2).Value2
End If
Set ws = Nothing
Set wb = Nothing
Set cht = Nothing
Set xlApp = Nothing
End Sub
I have very minimal knowledge about VBA but still learning as it goes.
I've been using bookmarks in the word in order to populate data from excel. However, due to the content that some data need to repeat in a document, I tried using Text Form Field/Bookmark and REF Field to duplicate the same data.
The problem came in when once I populated data to the word, the text form field/bookmark disappear which causes REF Field unable to track the data that was referred to, hence, the "Error! Reference source not found."
In conclusion, what I'm trying to do is to populate data from excel to a locked word document and at the same time to retain Text Field Form/Bookmark in order to let REF field to track and duplicate the same data.
Is there any way to retain the Text Field Form/Bookmark placeholder after data is populated to the word? Here's my code that I am unable to solve in excel VBA.
Appreciate your help in advance!
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "C:\Users\" & Environ("username") & "\Desktop\XXX\XXX"
objWord.ActiveDocument.Unprotect Password:="xxx"
With objWord.ActiveDocument
Dim objBMRange As Range
Set objBMRange = .Bookmarks("pr1").Range.Text = ws.Range("C28").Value
objBMRange.Text = pr1
.Bookmarks.Add "pr1", BMRange
.Fields.Update
objWord.ActiveDocument.Protect Password:="xxx", NoReset:=False, Type:=wdAllowOnlyFormFields
End With
Set objWord = Nothing
End Sub
You were almost there. Very near, but you didn't get the Range object sorted out. Please try this code (only partially tested).
Private Sub CommandButton1_Click()
Dim Ws As Worksheet
Dim objWord As Object
Dim Mark As String
Dim Txt As String
Dim BmkStart As Long
Mark = "pr1"
Set Ws = ThisWorkbook.Sheets("Sheet1")
Txt = Ws.Range("C28").Value
Set objWord = CreateObject("Word.Application")
With objWord
.Visible = True
.Documents.Open "C:\Users\" & Environ("username") & "\Desktop\XXX\XXX"
With .ActiveDocument
.Unprotect Password:="xxx"
If .Bookmarks.Exists(Mark) Then
With .Bookmarks(Mark).Range
BmkStart = .Start
.Text = Txt
End With
.Bookmarks.Add Mark, .Range(BmkStart, BmkStart + Len(Txt))
End If
.Fields.Update
.Protect Password:="xxx", NoReset:=False, Type:=wdAllowOnlyFormFields
End With
End With
Set objWord = Nothing
End Sub
One point is that the Bookmark defines a Word.Range (different from an Excel.Range which you get when you specify no application while working in Excel). The other, that Bookmark defines a range but isn't a range itself, not even a Word.Range. Therefore you get or set its text by modifying it's range's Text property.
I'm trying to search an MS Word doc for embedded Excel files and save them to a different location.
1) I want to record the page number and or section name (based on header style) the embedded file was located in the Word Doc. How can I extract this info?
2) Is there anyway to get the original filename of the embedded Excel file?
Here is the code I'm using to search for embedded files. Originally
Working off the code first presented here: Extract Embeded Excel Workseet Data
Sub TestMacro2()
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim lNumShapes As Long
Dim lShapeCnt As Long
Dim xlApp As Object
Dim wrdActDoc As Document
Dim iRow As Integer
Dim iCol As Integer
Set wrdActDoc = ActiveDocument
For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count
If wrdActDoc.InlineShapes(lShapeCnt).Type = wdInlineShapeEmbeddedOLEObject Then
If wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.ProgID = "Excel.Sheet.8" Then
wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.Edit
Set xlApp = GetObject(, "Excel.Application")
cpath = "location of interest"
xlApp.Workbooks(1).SaveAs cpath & " " & lShapeCnt
xlApp.Workbooks(1).Close
xlApp.Quit
Set xlApp = Nothing
End If
End If
Next lShapeCnt
End Sub
Note: Your code would be more efficient (and easier to read) if you assign an object that's re-used to a variable:
Dim ils as Word.InlineShape
Set ils = wrdActDoc.InlineShapes(lShapeCnt)
(1) The Range.Information method can return the page number. Something like:
Dim pageNumber as Long
pageNumber = ils.Range.Information(wdwdActiveEndPageNumber)
The other option is not as straight forward... I expect you really mean Heading style, not Header style. There is a built-in bookmark that will get the Heading preceding the current selection. That would be something like:
Dim secName as String
ils.Range.Select
secName = ActiveDocument.Bookmarks("\HeadingLevel").Range.Text
(2) If the file is not linked then your chances are slim. There's nothing VBA can get at directly, that's certain. Possibly, something might be stored in the WordOpenXML. You can check that by downloading the Open XML SDK Productivity Tool, opening such a document in it and inspecting that part of the Open XML. If it's in there then you can get at it in VBA using ils.Range.WordOpenXML to get the Open XML for the InlineShape, then parse that.