I have a word template that I am populating from an Access database recordset using VBA. I have bookmarked all of the relevant locations in the template and loop through the recordset using the .SaveAs command to create a new word doc with the data for each record; then repopulate the template for the next record. This is working fine for text.
My challenge now is to add images and a text description (variable number of images) to the word template at a bookmarked location. I have a second recordset queried from within the first recordset loop that has the full file path to the image location and the description of the image(s) for that record. I would like to add the description below the image.
For the text I am using the following from adapted from wordmvp.com
Private Sub btn_ExportWord_Click()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim rs As DAO.Recordset
Dim BMRange As Range
Dim filepath2 as String
Dim strQuery as String
'There is more included above here to define the file path and query but those are working just fine
Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open(filepath2)
Set rs = CurrentDb.OpenRecordset(strQuery)
If Not rs.EOF Then rs.MoveFirst
Do Until rs.EOF
'There are 44 bookmarks so only subset included here
Set BMRange = wDoc.Bookmarks("OtherNotesComments").Range
BMRange.Text = Nz(rs!OtherNotesComments, "")
wDoc.Bookmarks.Add "OtherNotesComments", BMRange
Set BMRange = Nothing
Set BMRange = wDoc.Bookmarks("OtherNotesComments").Range
BMRange.Text = Nz(rs!OtherNotesComments, "")
wDoc.Bookmarks.Add "OtherNotesComments", BMRange
Set BMRange = Nothing
wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"
rs.MoveNext
Loop
End Sub
I have used the following to insert all of the images successfully added before the .SaveAs; adding the required dimension of the new variables.
If Not rs2.EOF Then rs2.MoveFirst
Do Until rs2.EOF
Set BMImage = wDoc.Bookmarks("PFM_Images").Range
BMImage.InlineShapes.AddPicture FileName:=rs2!FullPath, LinkToFile:=False, SaveWithDocument:=True
wDoc.Bookmarks.Add "PFM_Images", BMImage
Set BMImage = Nothing
rs2.MoveNext
wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"
rs.MoveNext
Loop
What I cannot seem to figure out is how to add the description to the image. I have tried to use the InsertCaption method but get an error when attempting to use that with BMIMage range. Any help would be appreciated.
This is what ended up working in the end; actually two solutions. The first places the image description as plain text below the image, and the second uses the insertcaption method. The insertcaption method is producing some odd page break issues that have yet to be resolved but does work to include the description as a caption.
First solution uses the bookmarks("name").select to place the selection at the bookmark, in this case a placeholder bookmark. Then uses the with word_application.selection method to insert the image, a carriage return, the description, another carriage return, and then collapses to the end, moves to the next record and loops.
Set rs2 = CurrentDb.OpenRecordset(strQuery2)
If Not rs2.EOF Then
If Not rs2.EOF Then rs2.MoveFirst
wDoc.Bookmarks("PFM_IMages").Select
Do Until rs2.EOF
With wApp.Selection
.InlineShapes.AddPicture FileName:=rs2!FullPath, LinkToFile:=False, SaveWithDocument:=True
.InsertParagraphAfter
.InsertAfter Nz(rs2!Caption, "")
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
rs2.MoveNext
Loop
End If
wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"
rs.MoveNext
The second solution involves two loops, the first is as above but omitting the placement of the description text. Then moves back to the first record in the recordset dimensions an integer variable and an InlineShape variable and progresses through the recordset again from i = 1 to the end of the recordset.
Set rs2 = CurrentDb.OpenRecordset(strQuery2)
If Not rs2.EOF Then
If Not rs2.EOF Then rs2.MoveFirst
wDoc.Bookmarks("PFM_IMages").Select
Do Until rs2.EOF
With wApp.Selection
.InlineShapes.AddPicture FileName:=rs2!FullPath, LinkToFile:=False, SaveWithDocument:=True
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
rs2.MoveNext
Loop
rs2.MoveFirst
i = 1
Do Until rs2.EOF
Set ImageIsh = wDoc.InlineShapes(i)
ImageIsh.Range.InsertCaption Label:=-1, Title:=rs2!Caption, Position:=1, ExcludeLabel:=False
i = i + 1
rs2.MoveNext
Loop
End If
wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"
rs.MoveNext