Try the following
Dim oTable As Table
Dim oCell As Range
Set oTable = ActiveDocument.Tables(1)
ActiveWindow.View.ShowFieldCodes = True
For i = 1 To oTable.Rows.Count
Set oCell = oTable.Cell(i, oTable.Columns.Count).Range
oCell.End = oCell.End - 1
oCell.Fields.Add oCell, wdFieldIncludePicture, _
Text:=Chr(34) & "\\\\Printserver\\cblftp\\ " _
& Chr(34) & " \d", _
Preserveformatting:=False
Set oCell = oTable.Cell(i, oTable.Columns.Count).Range
oCell.End = oCell.End - 6
oCell.Start = oCell.End - 4
oCell.End = oCell.End - 3
oCell.Fields.Add oCell, wdFieldMergeField, _
Text:="PHOTO", Preserveformatting:=False
Next i
See also
http://www.gmayor.com/mail_merge_graphics.htm
--
Graham Mayor - Word MVP
My web site
www.gmayor.com
Word MVP web site
http://word.mvps.org
Medusa wrote:
hello there;
I've creating a mailmerge template in Word 2003. The datasource (in
excel) includes filenames for .jpg images - 1 image per record, set
against text fields (it's actually property details, with a picture
of the property).
The text fields are OK, but I recorded a macro, which I attached to
the template document, to type in the 'includePicture' command. The
way I want it to work is that the users open the template, open the
datasource, then run the macro to insert the 'Include picture'
command in the final column of a Word table.
This worked fine the first time I did it, but when I have tested it
again, the process is adding an additional copy of the image against
each record in the merged document - this is incrementing by 1 each
time I run the process.
The code in the macro is:
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText
Text:="IncludePicture""\\\\Printserver\\cblftp\\"
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, _ PreserveFormatting:=False Selection.MoveLeft
Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="MERGEFIELD
PHOTO" Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=""""
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="\d"
Selection.Delete Unit:=wdCharacter, Count:=1
End Sub
Can anybody help?
Thanks