Access - Insertar adjunto en postgreSQL y Access

Public Function SubirImagen(ByVal tableName As String, ByVal fieldName As String, ByVal imagePath As String, ByVal conditionField As String, ByVal conditionValue As String) As Boolean

'Método para subir una imagen al servidor de PostgreSQL

'Parámetros:

'            tablename ----- > Nombre de la tabla en PostgreSQL en la sentencia SQL

'            fieldName ----- > Nombre del campo bytea en PostgreSQL

'            imagePath ----- > Ruta y nombre del archivo de la imagen a subir

'            conditionField  > Nombre del campo del id, por ejemplo, idempleado

'            conditionValue  > Valor del ID, por ejemplo si el idempleado=3 seria 3

'Ejemplo de llamada:

'

' NOTA:

'La función   utiliza parámetros SQL para realizar la inserción y actualización directamente en la base de datos PostgreSQL.

'La función DiscoAOle()  lee el contenido binario del archivo y luego actualiza cada registro en el conjunto de resultados ADO con el contenido binario.

'En consecuencia esta función es más rápida o eficiente

    On Error GoTo ErrorHandler

    ' Variable booleana para rastrear errores

    Dim success As Boolean

    success = True

    ' Crear un objeto ADODB.Stream

    Dim objStream As Object

    Set objStream = CreateObject("ADODB.Stream")

    ' Especificar el tipo del Stream (adTypeBinary para datos binarios)

    objStream.Type = 1 ' adTypeBinary

    ' Abrir el Stream

    objStream.Open

    ' Leer la imagen desde un archivo

    objStream.LoadFromFile imagePath

    ' Crear un objeto de comando ADO

    Dim objCommand As Object

    Set objCommand = CreateObject("ADODB.Command")

    ' Especificar el SQL para la actualización de datos

    Dim strSQL As String

    strSQL = "UPDATE " & tableName & " SET " & fieldName & " = ? WHERE " & conditionField & " = ?"

    ' Configurar el comando

    objCommand.ActiveConnection = conn

    objCommand.CommandText = strSQL

    ' Agregar el primer parámetro de imagen al comando

    Dim objParameter1 As Object

    Set objParameter1 = objCommand.CreateParameter(fieldName, 205, 1, -1, objStream.Read)

    objCommand.Parameters.Append objParameter1

    ' Agregar el segundo parámetro de condición al comando

    Dim objParameter2 As Object

    Set objParameter2 = objCommand.CreateParameter(conditionField, adVarChar, adParamInput, Len(conditionValue), conditionValue)

    objCommand.Parameters.Append objParameter2

    ' Ejecutar el comando (realizar la actualización)

    objCommand.Execute

    ' Cerrar y liberar recursos

    objStream.Close

    Set objStream = Nothing

    Set objCommand = Nothing

    ' Devolver el resultado

    SubirImagen = success

    Exit Function

ErrorHandler:

    Debug.Print "Error al actualizar imagen: " & Err.Description

    ' Si se produce un error, establecer el resultado en False

    success = False

    SubirImagen = success

End Function

Public Function DescargarImagen(ByVal tableName As String, ByVal fieldName As String, ByVal conditionField As String, ByVal conditionValue As String, ByVal outputPath As String) As Boolean

    On Error GoTo ErrorHandler

    ' Variable booleana para rastrear errores

    Dim success As Boolean

    success = True

    ' Crear un objeto de comando ADO

    Dim objCommand As Object

    Set objCommand = CreateObject("ADODB.Command")

    ' Especificar el SQL para la selección de datos

    Dim strSQL As String

    strSQL = "SELECT " & fieldName & " FROM " & tableName & " WHERE " & conditionField & " = ?"

    ' Configurar el comando

    objCommand.ActiveConnection = conn

    objCommand.CommandText = strSQL

    ' Agregar el parámetro de condición al comando

    Dim objParameter As Object

    Set objParameter = objCommand.CreateParameter(conditionField, adVarChar, adParamInput, Len(conditionValue), conditionValue)

    objCommand.Parameters.Append objParameter

    ' Abrir un Recordset con la imagen

    Set rs = objCommand.Execute

    ' Verificar si se encontraron resultados

    If Not rs.EOF Then

        ' Crear un objeto ADODB.Stream para la imagen

        Dim objStream As Object

        Set objStream = CreateObject("ADODB.Stream")

        ' Especificar el tipo del Stream (adTypeBinary para datos binarios)

        objStream.Type = 1 ' adTypeBinary

        ' Abrir el Stream

        objStream.Open

        ' Copiar el contenido del campo bytea al Stream

        objStream.Write rs.Fields(fieldName).Value

        ' Guardar la imagen en disco

        objStream.SaveToFile outputPath, 2 ' adSaveCreateOverWrite

        ' Cerrar el Stream

        objStream.Close

    Else

        Debug.Print "No se encontró la imagen para la condición especificada."

        success = False

    End If

    ' Cerrar y liberar recursos

    rs.Close

    Set rs = Nothing

    Set objCommand = Nothing

    ' Devolver el resultado

    DescargarImagen = success

    Exit Function

ErrorHandler:

    Debug.Print "Error al descargar imagen: " & Err.Description

    ' Si se produce un error, establecer el resultado en False

    success = False

    DescargarImagen = success

End Function

Public Function OleADisco(ByVal tabla As String, ByVal id As Long, ByVal campoOLE As String, ByVal nombreArchivo As String, ByVal campoWhere As String, Optional Tipo As Byte) As String

'Referenciar  Microsoft ActiveX Data Objects x.x Library

'En este código actualizado, se utiliza un objeto ADODB.Stream para leer los datos del campo bytea.

'Los datos se escriben en el Stream y luego se leen en el arreglo de bytes Matrix.

'Esto para evitar error 13 no coinciden los tipos cuando el campo bytea esta vacío.

    Dim rst As New ADODB.Recordset

    Dim sql, Ruta As String

    Dim Matrix() As Byte

    Dim NumArchivo As Byte

    Dim conexion As Variant

     On Error GoTo ManipularError

    ' Verificar si la conexión está abierta

    conexion = OpenConnection()

    sql = "SELECT * FROM " & tabla & " WHERE " & campoWhere & " = " & id

    rst.Open sql, conn, adOpenForwardOnly, adLockReadOnly

    With rst

        NumArchivo = FreeFile

        Ruta = CurrentProject.Path & "\" & nombreArchivo

        If Not IsNull(.Fields(campoOLE).Value) Then

            If LenB(.Fields(campoOLE).Value) > 0 Then

                Dim Stream As Object

                Set Stream = CreateObject("ADODB.Stream")

                Stream.Type = adTypeBinary

                Stream.Open

                Stream.Write .Fields(campoOLE).Value

                Stream.Position = 0

                Matrix = Stream.Read

                Stream.Close

            Else

                OleADisco = ""

                Exit Function

            End If

        Else

            OleADisco = ""

            Exit Function

        End If

    End With

    rst.Close: Set rst = Nothing

    Open Ruta For Binary Access Write As #NumArchivo

    Put #NumArchivo, 1, Matrix

    Close #NumArchivo

    OleADisco = Ruta

    ' conn.Close 'Si la activo se oculta el formulario imagenes

    Exit Function

ManipularError:

    If Not rst Is Nothing Then rst.Close: Set rst = Nothing

    MsgBox Err.Number & "Error al descargar la imagen" & vbCrLf & vbCrLf & Err.Description, vbCritical, "Atención"

    Resume Next

    Exit Function

End Function

Public Function DiscoAOle(ByVal tabla As String, ByVal id As Long, ByVal campoOLE As String, ByVal nombreArchivo As String, ByVal campoWhere As String, Optional Tipo As Byte) As Boolean

    Dim rst As New ADODB.Recordset

    Dim sql As String, Ruta As String

    Dim NumArchivo As Byte, Aux As Boolean

    Dim Matrix() As Byte

    Dim conexion As Variant

    On Error GoTo ManipularError

    ' Verificar si la conexión está abierta

    conexion = OpenConnection()

    If Tipo = 1 Then

        sql = "SELECT * FROM " & tabla

    Else

        sql = "SELECT * FROM " & tabla & " WHERE " & campoWhere & "=" & id

    End If

    rst.Open sql, conn, adOpenDynamic, adLockOptimistic

    NumArchivo = FreeFile

    Ruta = nombreArchivo

    Aux = True: Open Ruta For Binary Access Read As #NumArchivo

    ReDim Matrix(LOF(NumArchivo) - 1)

    Get #NumArchivo, , Matrix

    Close #NumArchivo: Aux = False

    With rst

        If Not .BOF And Not .EOF Then

            .MoveFirst

            Do While Not .EOF

                .Fields(campoOLE).Value = Matrix

                .Update

                .MoveNext

            Loop

        End If

    End With

    rst.Close

    'conn.Close  'Si se cierra se oculta el formulario imagenes

    If Tipo = 1 Then

        MsgBox "Registro agregado correctamente.", vbInformation, "Aviso"

    Else

'        MsgBox "Registro editado correctamente.", vbInformation, "Aviso"

    End If

    DiscoAOle = True

Exit Function

ManipularError:

    If Aux Then: Close #NumArchivo

    MsgBox Err.Number & "Error al descargar la imagen" & vbCrLf & vbCrLf & Err.Description, vbCritical, "Atención"

    Exit Function

End Function

CREATE OR REPLACE FUNCTION es_bytea_vacio(nombre_tabla text, nombre_campo_bytea text, nombre_campo_id text, valor_id INT)

RETURNS BOOLEAN AS $$

DECLARE

    campo_vacio BOOLEAN;

BEGIN

    EXECUTE 'SELECT COALESCE(LENGTH(' || quote_ident(nombre_campo_bytea) || '), 0) = 0 FROM ' || quote_ident(nombre_tabla) || ' WHERE ' || quote_ident(nombre_campo_id) || ' = $1' INTO campo_vacio

    USING valor_id;

    RETURN campo_vacio;

END;

$$ LANGUAGE plpgsql;

-- Llamando a la función para comprobar si el campo bytea 'mi_campo_bytea' en la tabla 'mi_tabla' para el idimagen 1 está vacío

SELECT es_bytea_vacio('mi_tabla', 'mi_campo_bytea', 'idimagen', 1);