Import binary image stored on SQL server into microsoft word RRS feed

  • Question

  • Hello,

    I am trying to import an image stored as binary on an SQL server directly into MS word using VBA but I am struggling to find a solution? any ideas?



    Saturday, November 23, 2019 1:21 AM

All replies

  • Depends on what you mean by "directly".

    If you are allowed to save to a local file, you could start with something along the following lines (your VBA module would need a reference to Microsoft ADO to make sense of this). All sorts of things are hard-coded in one way or another. In my test database, the images are all jpg format stored in a varbinary(max) column. If you are storing some other way, or mixed formats, or you are storing *image objects* of some kind, e.g. with an OLE wrapper, this won't work.

    Function insertImageFromSQLServer(insertRange As Word.Range, connectString As String, queryString As String, key As Long, imageField As String, tempImageFile As String) As Boolean
    Const chunkSize As Long = 10000
    Dim cn As ADODB.Connection
    Dim cm As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim st As ADODB.Stream
    Dim offset As Long
    Dim result As Boolean
    result = False
    'On Error GoTo problem
    Set cn = New ADODB.Connection
    cn.ConnectionString = connectString
    Set cm = New ADODB.Command
    cm.CommandType = adCmdText
    cm.Parameters.Append cm.CreateParameter("key", adInteger, adParamInput, , key)
    cm.CommandText = queryString
    Set cm.ActiveConnection = cn
    'Set rs = New ADODB.Recordset
    Set rs = cm.Execute
    If Not rs.BOF Then ' got something
      Set st = New ADODB.Stream
      st.Type = adTypeBinary
      offset = 0
      With rs.Fields(imageField)
        Do While offset < .ActualSize
          st.Write .GetChunk(chunkSize)
          offset = offset + chunkSize
      End With
      st.SaveToFile tempImageFile, adSaveCreateOverWrite
      Set st = Nothing
      insertRange.InlineShapes.AddPicture FileName:=tempImageFile, LinkToFile:=False, SaveWithDocument:=True
      result = True
    End If
    Set rs = Nothing
    Set cm = Nothing
    Set cn = Nothing
    GoTo finish
    Debug.Print "Error " & CStr(Err.Number) & ": " & Err.Description
    If Not (st Is Nothing) Then
      Set st = Nothing
    End If
    If Not (rs Is Nothing) Then
      Set rs.ActiveCommand = Nothing
      Set rs = Nothing
    End If
    If Not (cm Is Nothing) Then
      Set cm.ActiveConnection = Nothing
      Set cm = Nothing
    End If
    If Not (cn Is Nothing) Then
      If cn.State <> 0 Then
      End If
      Set cn = Nothing
    End If
    insertImageFromSQLServer = result
    End Function
    Sub testInsertImageFromSQLServer()
    ' Insert 5 jpg images from rows with Id=1, 2, 3, 4, 5 in the first 5 paras. of the active document
    Const connectString As String = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=mytestdb;Data Source=localhost;"
    Const queryString = "SELECT [Id], [Description], [Image] FROM dbo.kimage WHERE Id=?"
    Const imageField As String = "Image"
    Const tempImageFile As String = "c:\a\temp.jpg"
    Dim insertRange As Word.Range
    Dim i As Long
    For i = 1 To 5
      Set insertRange = ActiveDocument.Paragraphs(i).Range
      If Not insertImageFromSQLServer(insertRange, connectString, queryString, i, "Image", tempImageFile) Then
        MsgBox "Could not insert image " & CStr(i)
      End If
      Set insertRange = Nothing
    End Sub

    Word's normal methods for adding pictures require that the pictures are in individual files in the file system. Ideally you would be able to insert from a stream and avoid have to save to disk, but as far as I know there is no support for that.  Alternatives might be be to retrieve the image using similar code to the above, but then either put the binary data on the clipboard, e.g. using Leigh Webber's Clipboard code (see, e.g. ), or generate a Word XML Flat Opc format file in memory and insert that using InsertXML.

    Peter Jamieson

    • Edited by Peter Jamieson Monday, November 25, 2019 4:54 PM Additional remarks
    Sunday, November 24, 2019 3:56 PM
  • Perhaps you could have the courtesy to respond.

    Peter Jamieson

    Tuesday, November 26, 2019 9:49 PM