Public Sub GDI_LoadPictures()
    Dim rst As ADODB.Recordset
    Dim strSQL  As String
    Dim strTableName As String
    Dim objPicture As StdPicture
    Dim arrPicture() As Byte
    Dim strTempPath As String
    Dim strPath As String
    Dim objStream As ADODB.stream
 
    Set rst = New ADODB.Recordset
 
    strTableName = GetTableName("xx0")  ' Tabellenname
    strSQL = "Select * from " & strTableName
    strTempPath = "c:\temp\Icons\Stream\"
 
    Call rst.Open(strSQL, GetConn(), adOpenDynamic, adLockOptimistic)
 
    Set objStream = New ADODB.stream
    Call InitGDIP
    While Not rst.EOF
        Debug.Print rst!striconfilename
        strPath = strTempPath & rst!striconfilename
        With objStream
            .Open
            .Type = adTypeBinary
            .Write (rst!objImage)
            .SaveToFile strPath, adSaveCreateOverWrite
            .Close
        End With
        Set objPicture = LoadPictureGDIP(strPath)               ' hier kommt 
        ' Fehler 2
        arrPicture = ArrayFromPicture(objPicture, pictypebmp)
 
        With rst
            !objPictureData = arrPicture
            .Update
            .MoveNext
        End With
    Wend
 
    Set rst = Nothing
    Set objPicture = Nothing
    Set objStream = Nothing
End Sub

Function LoadPictureGDIP(sFileName As String) As StdPicture
    Dim hBmp As Long
    Dim hPic As Long
 
    If lGDIP = 0 Then InitGDIP: If lGDIP = 0 Then Exit Function
    If GdipCreateBitmapFromFile(StrPtr(sFileName), hPic) = 0 Then
        GdipCreateHBITMAPFromBitmap hPic, hBmp, vbWhite
        If hBmp <> 0 Then
            Set LoadPictureGDIP = BitmapToPicture(hBmp)
            GdipDisposeImage hPic
        End If
    End If
 
End Function