VBA Access. Grabar fichero imagen en una tabla Sql Server.

'Ejemplo tabla Sql Server
'TABLE [dbo].[Imagenes](
' [CodigoImagen] [int] NOT NULL,
' [Fichero] [nvarchar](255) NOT NULL,
' [KBSize] [float] NOT NULL CONSTRAINT [DF_Imagenes_New_KBSize]  DEFAULT ((0))
' [Imagen] [image] NULL

')

Option Compare Database
Option Explicit

Private Enum MsoFileDialogType
    msoFileDialogOpen = 1           'Permite al usuario abrir un archivo.
    msoFileDialogSaveAs = 2         'Permite al usuario guardar un archivo.
    msoFileDialogFilePicker = 3     'Permite al usuario seleccionar un archivo.
    msoFileDialogFolderPicker = 4   'Permite al usuario seleccionar una carpeta.
End Enum

Private Function SelectItem(ByVal tipo As MsoFileDialogType) As String
On Error GoTo error
    Dim fDialog As Object
    Dim intResult As Integer
    Dim strPath As String
    strPath = ""

    Set fDialog = Application.FileDialog(tipo)

    intResult = Application.FileDialog(tipo).Show
    If intResult <> 0 Then
        strPath = Application.FileDialog(tipo).SelectedItems(1)
    End If
 
    SelectItem = strPath

Exit Function
error:
    SelectItem = ""
    MsgBox Err.Description
End Function

Private Sub cmdSaveToDB_Click()
On Error GoTo error
    Dim sFile As String
    sFile = SelectItem(msoFileDialogFilePicker)
    If sFile = "" Then Exit Sub
   
    Dim fso As New FileSystemObject
    Dim rs As New ADODB.Recordset
    Dim cn As New ADODB.Connection
   
    cn.ConnectionString = DimeCadenaConexion
    cn.Open
   
    rs.Open "SELECT TOP 0 * FROM Imagenes", cn, adOpenStatic, adLockPessimistic
   
    rs.AddNew
       
    rs!CodigoImagen = cn.Execute("SELECT ISNULL(MAX(CodigoImagen),0) + 1 AS NewCodigoImagen FROM Imagenes")!NewCodigoImagen
    rs!Fichero = fso.GetFileName(sFile)
    rs!KBSize = Round(fso.GetFile(sFile).Size / 1024, 2)
   
    'insertar imagen a bdd
    Dim objStream As New ADODB.Stream
    objStream.Type = adTypeBinary
    objStream.Open
    objStream.LoadFromFile sFile
    rs!Imagen = objStream.Read
    objStream.Close
    Set objStream = Nothing
   
    rs.Update
    rs.Close
    cn.Close
    Set rs = Nothing
    Set fso = Nothing
   
Exit Sub
Resume
error:
    MsgBox Err.Number & ": " & Err.Description

End Sub