views:

190

answers:

1

Hi all,

Is there a way to get the attachment from the form to an SQL Server column using VBA? There are some examples about encodind and decoding attachments, though is this the case?

Does SQL server support attachments somehow?

Thanks in advance, Sun

A: 

You can store files in SQL server in a VarBinary(Max) Column. This will store what ever you put in there so you can retrieve it later. If you are using SQL server 2008 you can also make use of the filestream feature which is very powerful and works in exactly the same way

Here is some code in an access/VBA project I have that will download a file that is stored in SQL server and save it to disk

Public Sub Download_file(lMaterial_ID As Long, strSave_folder As String)
'Download the file lMaterial_ID and save it 
Dim adStream As ADODB.Stream
Dim rst As ADODB.Recordset
On Error GoTo Error_trap
On Error GoTo 0
'check if we have an open connection, if we do use it
Select Case dbCon.State
    Case adStateOpen
        'connection is open, do nothing
    Case adStateConnecting
        'still conecting wait
        Do Until dbCon.State = adStateOpen
            Application.Echo True, "Connection to DB"
        Loop
    Case adStateClosed
        'connection closed, try to open it
        If Len(strSQL_con_string) = 0 Then
            Set_SQL_con
        End If
        dbCon.ConnectionString = strSQL_con_string
        dbCon.Provider = "sqloledb"
        dbCon.Open
End Select

Me.acxProg_bar.Value = 0
Me.acxProg_bar.Visible = True
Me.Repaint

Set adStream = New ADODB.Stream
adStream.Type = adTypeBinary
adStream.Open


Set rst = New ADODB.Recordset
rst.Open "SELECT Material_FS, Material_file_name FROM tblMaterials WITH (NOLOCK) WHERE Material_ID=" & lMaterial_ID, dbCon, adOpenForwardOnly, adLockReadOnly
Me.acxProg_bar.Value = 60
Me.Repaint
If IsNull(rst.Fields("Material_FS").Value) = False Then
    adStream.Write rst.Fields("Material_FS").Value
    Me.acxProg_bar.Value = 80
    Me.Repaint
    adStream.SaveToFile strSave_folder & "\" & rst.Fields("Material_file_name").Value, adSaveCreateOverWrite
End If
rst.Close
dbCon.Close
Me.acxProg_bar.Value = 0
Me.acxProg_bar.Visible = False
Me.Repaint


Exit Sub

Error_trap:

If dbCon Is Nothing = False Then
    If dbCon.State = adStateOpen Then dbCon.Close
End If

DoCmd.Hourglass False
MsgBox "An error happened in sub Download_file, error description, " & Err.Description, vbCritical, "MCTS"
Me.acxProg_bar.Value = 0
Me.acxProg_bar.Visible = False
Me.Repaint
End Sub
Kevin Ross