A solution, not a question! 1

[Rauken]

After numerous cups of coffee I finally found a solution for my problem. It works and I don't know how to do it otherwise.

Background: I have a couple of tables in Sql Server, one of the tables stores images. All tables are linked in an Access database which also contains native Access tables.

My client has developed a report based on these table and wanted the images to be included.

The report is built on a query which has the name of the image. I placed an image control on the report, imgLogo.

In the report's OnOpen event I create all the images that are connected to the query. Like this:

Private Sub Report_Open(Cancel As Integer)

Dim strRecSource As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSql As String

strRecSource = Me.RecordSource
Set db = CurrentDb
strSql = "SELECT * FROM " & strRecSource
Set rs = db.OpenRecordset(strSql)
Do While Not rs.EOF
CreateImageOnDisk rs("id"), rs("file_name")
rs.MoveNext
Loop

End Sub

My CreateImageOnDisk function looks like this:

Public Sub CreateImageOnDisk(intID As Integer, strFileName As String)

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSql As String
Dim mStream As ADODB.Stream

Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB;data Source=localhost;Initial Catalog=procdb;User Id=sa;Password="

Set rs = New ADODB.Recordset
strSql = "SELECT * FROM prod_files WHERE ID = " & intID & " AND file_name = '" & strFileName & "'"
rs.Open strSql, cn, adOpenForwardOnly, adLockOptimistic

Set mStream = New ADODB.Stream
mStream.Type = adTypeBinary
mStream.Open
mStream.Write rs("file_binary")
mStream.SaveToFile Application.CurrentProject.Path & "\" & strFileName, adSaveCreateOverWrite

End Sub

And in the OnFormat event I used the code which I found in the great thread about images in report.

Me.imgLogo.Properties("Picture") = Application.CurrentProject.Path & "\" & Me.file_name

To save diskspace I delete all the images from the computer when exiting.

Anyone comments on this? I'd be glad to hear if you find an easier way of doing it.

 

[VBslammer]

I would use a single connection instead of opening a new connection for each image. You can add a module-level variable in the report's module to hold the connection object, and do something like this:

Option Explicit

Private mcnnSQLServer As New ADODB.Connection

[green]'@--------------------------------------------------------@[/green]

Private Sub Report_Open(Cancel As Integer)
  Dim strRecSource As String
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim strSql As String
    
  strRecSource = Me.RecordSource
  Set db = CurrentDb
  strSql = "SELECT * FROM " & strRecSource

  Set rs = db.OpenRecordset(strSql)

  If OpenSQLServerConnection() = True Then
    While Not rs.EOF
      Call CreateImageOnDisk( rs("id"), rs("file_name"), mcnnSQLServer)
      rs.MoveNext
    Wend
    Call CloseSQLServerConnection()
  Else
    MsgBox "Couldn't open SQL Server connection."
    Cancel = True
  End If
End Sub

[green]'@--------------------------------------------------------@[/green]

Private Function OpenSQLServerConnection() As Boolean
On Error GoTo ErrHandler
  
  With mcnnSQLServer
    .Open "Provider=SQLOLEDB;data Source=localhost;Initial Catalog=procdb;User Id=sa;Password="
    OpenSQLServerConnection = (.State = adStateOpen)
  End With

ExitHere:
  Exit Function
ErrHandler:
  Debug.Print Err, Err.Description
  Resume ExitHere
End Function

[green]'@--------------------------------------------------------@[/green]

Private Sub CloseSQLServerConnection()
On Error Resume Next
  With mcnnSQLServer
    If .State = adStateOpen Then
      .Close
    End If
  End With
End Sub

Public routine:

Public Sub CreateImageOnDisk(ByVal lngID As Long, _
                             ByVal strFileName As String, _
                             ByRef cnn As ADODB.Connection)
  Dim rs As New ADODB.Recordset
  Dim mStream As New ADODB.Stream
  Dim strSql As String
 
  If cnn.State = adStateOpen Then
    strSql = "SELECT * FROM prod_files WHERE ID = " & lngID & " AND file_name = '" & strFileName & "'"
    rs.Open strSql, cnn, adOpenForwardOnly, adLockOptimistic
    
    mStream.Type = adTypeBinary
    mStream.Open
    mStream.Write rs("file_binary")
    mStream.SaveToFile Application.CurrentProject.Path & "\" & strFileName, adSaveCreateOverWrite
  End If
End Sub

VBSlammer

"You just have to know which screws to turn." - Professor Bob

 

[Rauken]

Thanks for the star! Yes I agree the solution needed the final touch, thanks. Sorry forgot to close the connection, I'll use your updated code when I install it next week.

Whenever I've posted my question on different forums people say, put the images on the network and link with a path stored in a table. I would do that if I could. In my situation the webservers are clustred and I'm not allowed to store images anywhere else, I had no option.