I got this to work on mine.
Code:
Option Compare Database
Private Sub openinword(graphimage As String)
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Dim filesave As String
Dim objWdRange As Word.Range
Dim shortString As String
filesave = "C:\Users\Andy\Documents\pictureimport_test.docx" ' change as you wish
DeleteFile (filesave)
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Users\Andy\Documents\pictureimport.docx") 'this is the word file with the bookmark Graphimage in it
With wrdDoc
' If .Bookmarks.Exists("pic2") Then
' .Bookmarks("pic2").Range.Text = shortString
' End If
If .Bookmarks.Exists("GraphImage") Then
Dim wrdPic As Word.InlineShape
Set wrdPic = .Bookmarks("GraphImage").Range.InlineShapes.AddPicture(filename:=graphimage, LinkToFile:=False, SaveWithDocument:=True)
wrdPic.ScaleHeight = 50
wrdPic.ScaleWidth = 50
End If
.SaveAs "C:\Users\Andy\Documents\pictureimport_test.docx"
End With
wrdDoc.Close
Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing
End Sub
Sub DeleteFile(ByVal FileToDelete As String)
If FileExists(FileToDelete) Then 'See above
' First remove readonly attribute, if set
SetAttr FileToDelete, vbNormal
' Then delete the file
Kill FileToDelete
End If
End Sub
Function FileExists(ByVal FileToTest As String) As Boolean
FileExists = (Dir(FileToTest) <> "")
End Function
Private Sub picturesaving()
'saves the picture in the attachment field [Picturefield] as the file picsaved.jpg
'assumes TableName Is "tbl_pictures"
'Field Is picturefield
'make sure you have the microsoftword object Library reference (I had 14.0)
Dim db As Database
Dim rst As DAO.Recordset
Dim rsA As DAO.Recordset
Dim filename As String
filename = "C:\Users\Andy\Documents\picsaved.jpg" 'change accordingly for your directory
Set db = CurrentDb
Set rst = db.OpenRecordset("tbl_pictures") 'replace with qrysomething if you have one
Set rsA = rst.Fields("picturefield").Value
DeleteFile (filename) ' check to see if the file exists and deletes it
rsA.Fields("FileData").SaveToFile filename
openinword (filename)
rsA.Close
Set rsA = Nothing
End Sub
Limitations - it gets one picture from the table. You may need to tweak it slightly as I'm sure you'll have more than one attachment in your table.
But you can replace the name of a query where I have indicated