[RESOLVED] Loading pic from DB (Error Multiple-Step OLE DB)

[space_monkey]

Hey,

I found a good example from Rhino Bull on how to load and extract a picture to/from a db. My problem seems to be occuring when i try to extract the picture from the db. I get the Multiple-Step OLE DB Error. I'm using SQL Server.

'get all chunks and write then to a temp file
        For block_num = 1 To num_blocks
            [color=#CC0000]bytes() = adoRST.Fields("CARD_PICT_IMAG").GetChunk(BLOCK_SIZE)[/color][color=#CC0000][/color]
            Put #file_num, , bytes()
        Next block_num

The red line is the one is the one that is bugging me.
Any help is appreciated.

Also i want to check and make sure that my loadPic is putting the data into the db field properly. How can i do that?

Thanks
Andy

[RobDog888]

Looks like something is missing.

ReDim bytes(BLOCK_SIZE)

[color=navyOr you may have it dimed to an incorrect chunk size causing an overflow which can be the multistep error.[/color]

[space_monkey]

Hey Rob,

I tried out what you suggested but i got the same result.
Right now the BLOCK_SIZE is set to 10000 but i've tried at several different things such as, 256 1024. None of which worked.

file_num = FreeFile
    Open file_name For Binary As #file_num
        ' Copy the data into the file.
        file_length = adoRST.Fields("CARD_PICT_SIZE")
        
        num_blocks = file_length / BLOCK_SIZE
        left_over = file_length Mod BLOCK_SIZE
        
        ReDim bytes(BLOCK_SIZE)
        'get all chunks and write then to a temp file
        For block_num = 1 To num_blocks
            bytes() = adoRST.Fields("CARD_PICT_IMAG").GetChunk(BLOCK_SIZE)
            Put #file_num, , bytes()
        Next block_num
        If left_over > 0 Then
            ReDim bytes(left_over)
            bytes() = adoRST.Fields("CARD_PICT_IMAG").GetChunk(left_over)
            Put #file_num, , bytes()
        End If
    Close #file_num

[RobDog888]

I dont have access to SQL Server currently so its hard to test his example. Is your field type a OLE Object or ?

[space_monkey]

I don't see an explicit OLE Object Datatype, so i've been using the Image Datatype. Is that incorrect?

[space_monkey]

I'm still not sure what i was doing wrong with Rhino's example but here's what i ended up doing. Thanks Rob for trying to help.

Private Sub LoadPic_DB(ByVal lPicNum As Long)
Dim strFilename As String
Dim rsTemp As adodb.Recordset
Dim strResponse As String
Dim strSQL As String
Dim strTitle As String
Dim adoCmd As adodb.Command
Dim mstream As adodb.Stream
 
    cdMain.ShowOpen
    
    strFilename = cdMain.FileName
 
    strResponse = MsgBox("Are you sure you want to load this picture?", vbInformation + vbYesNo, "LOAD")
 
    If strResponse = vbNo Then
        Exit Sub
    End If
 
    strTitle = UserPermissions.strUserName & "_" & Format(Now, "yyyymmddhhnnss")
 
    strSQL = "Insert into CARD_PICT ([CARD_PICT_ID]) VALUES ('"
    strSQL = strSQL & strTitle & "')"
 
    Set adoCmd = New adodb.Command
 
    With adoCmd
        .CommandText = strSQL
        .CommandType = adCmdText
        .ActiveConnection = strCon
        .Execute
    End With
 
    Set rsTemp = New adodb.Recordset
    rsTemp.Open "CARD_PICT", strCon, adOpenKeyset, adLockPessimistic, adCmdTable
 
    rsTemp.Find "CARD_PICT_ID ='" & strTitle & "'"
    
    rsTemp.Fields("CARD_PICT_TYPE") = Trim(Mid(strFilename, InStr(1, strFilename, ".")))
    
    Set mstream = New adodb.Stream
    mstream.Type = adTypeBinary
    mstream.Open
    mstream.LoadFromFile strFilename
    
    rsTemp.Fields("CARD_PICT_IMAG").Value = mstream.Read
    rsTemp.Update
 
    'AddNewImage rsTemp, strTitle, strFileName
    
    MsgBox "Picture has been added!", vbInformation, "Success"
    
    Select Case lPicNum
        Case 1
            strPic1_ID = strTitle
        Case 2
            strPic2_ID = strTitle
        Case 3
            strPic3_ID = strTitle
    End Select
    
    If rsTemp.State = adStateOpen Then
        rsTemp.Close
        Set rsTemp = Nothing
    End If
 
End Sub
 
Private Sub OpenImage(ByVal lPicNum As Long)
Dim rsTemp As adodb.Recordset
Dim mstream As adodb.Stream
Dim strTitle As String
Dim strFilename As String
Dim strType As String
 
    Set rsTemp = New adodb.Recordset
    rsTemp.Open "CARD_PICT", strCon, adOpenKeyset, adLockPessimistic, adCmdTable
    
    Select Case lPicNum
        Case 1
            strTitle = strPic1_ID
        Case 2
            strTitle = strPic2_ID
        Case 3
            strTitle = strPic3_ID
    End Select
    
 
    rsTemp.Find "CARD_PICT_ID ='" & strTitle & "'"
 
    strType = rsTemp.Fields("CARD_PICT_TYPE")
 
    Set mstream = New adodb.Stream
    mstream.Type = adTypeBinary
    mstream.Open
    mstream.Write rsTemp.Fields("CARD_PICT_IMAG").Value
    
    strFilename = App.Path & "\PICS\" & strTitle & strType
    mstream.SaveToFile strFilename, adSaveCreateOverWrite
    
    Select Case lPicNum
        Case 1
                img1.Picture = LoadPicture(strFilename)
        Case 2
                img2.Picture = LoadPicture(strFilename)
        Case 3
                img3.Picture = LoadPicture(strFilename)
    End Select
    
    
    If rsTemp.State = adStateOpen Then
        rsTemp.Close
        Set rsTemp = Nothing
    End If
 
End Sub