Bestanden opslaan in Sql server database via VBA

[harolda1980]

IK had een hele mooie code die bestanden in een database kon zetten voor MySql in VBA.
Alleen via MS SQL heb ik er toch opeens een hele boel problemen mee.

Tijdens het laatste rondje testen komt er zo waar een document in de database en tja hij komt er ook nog uit.

Maar ik dacht laat ik de code dan maar delen met iedereen!

Private Sub Start()
Dim cn As ADODB.Connection
    Set cn = New ADODB.Connection
    cn.Provider = "sqloledb"
    cn.Properties("Data Source").Value = "MS2\VERMAATSQL"
    cn.Properties("Initial Catalog").Value = "Test"
    cn.Properties("Integrated Security").Value = "SSPI"
    cn.Open
 
    Dim Filesource As String
    Dim Filename As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim mystream As ADODB.Stream
    Set mystream = New ADODB.Stream
    mystream.Type = adTypeBinary

    rs.Open "SELECT flies.File_id, flies.file_name, flies.file_f FROM  dbo.flies where 1=0", cn, adOpenStatic, adLockOptimistic
    rs.AddNew
    MsgBox statereturn(cn.State)

    Filesource = "W:\Hcontent\test\"
    Filename = "Heinekenbrouwerij.pdf"
    mystream.Open
    mystream.LoadFromFile Filesource & Filename
    rs!file_name = Filename
    rs!file_f = mystream.Read
    MsgBox statereturn(cn.State)
    rs.Update
    mystream.Close
    rs.Close
    MsgBox statereturn(cn.State)
    Set rs = New ADODB.Recordset
    Set mystream = New ADODB.Stream
    
    rs.Open "SELECT flies.File_id, flies.file_name, flies.file_f FROM  dbo.flies where flies.File_id =1", cn, adOpenStatic, adLockOptimistic
    MsgBox statereturn(cn.State)

'    Filesource = "W:\Hcontent\test\"
'    Filename = "Heinekenbrouwerij.pdf"
    
    mystream.Open
    mystream.Type = adTypeBinary
    mystream.Write rs!file_f
    mystream.SaveToFile "\\Fp1\vba\" & "test.pdf"
    mystream.Close
    rs.Close
    MsgBox statereturn(cn.State)
    
        
End Sub


Function statereturn(IntState As Integer) As String

Select Case IntState
Case 0
    statereturn = "Verbinding gesloten"
Case 1
        statereturn = "Verbinding open"
Case 2
    statereturn = "Verbinding gesloten"
Case 4
    statereturn = "Uitvoeren van een database aanvraag"
Case 8
    statereturn = "informatie word teruggegeven"
Case Else
    statereturn = "Foutmelding"
End Select

    
End Function