** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - DATOS ADJUNTOS
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

DATOS ADJUNTOS

 Responder Responder
Autor
Mensaje
Nanipepe Ver desplegable
Nuevo
Nuevo


Unido: 11/Junio/2009
Localización: España
Estado: Sin conexión
Puntos: 17
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Nanipepe Cita  ResponderRespuesta Enlace directo a este mensaje Tema: DATOS ADJUNTOS
    Enviado: 20/Julio/2022 a las 14:12
Buenos días, por favor, necesitaría saber como extraer los datos adjuntos de una tabla y guardarlos en el disco.
Yo venía utilizando un método, seguramente aportado por alguno de vosotros, tal que:
 Dim dbs As DAO.Database
    Dim rst As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fld As DAO.Field2

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("OFERTAS1")
    Set fld = rst("DOC_ADJUDICACION")

pero me está dando el erro de que en la última línea que no coinciden los tipos
gracias

Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14720
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita xavi Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 20/Julio/2022 a las 15:40
Hola,

Esquemáticamente
- Declaras 2 recordsets como DAO.Recordset2
- Uno sobre la tabla filtrado al registro adecuado
- Otro sobre el campo de la tabla que contiene los adjuntos
- Finalmente utilizas el método SaveToFile para extraer a la ruta.

Escrito al vuelo:

Dim rstTabla As DAO.Recordset2
Dim rstAdjuntos As DAO.Recordset2
Set rstTabla = CurrentDb.OpenRecordset("SELECT * FROM UnTabla WHERE UnCampo = UnaCondicion")
Set rstAdjuntos = rstTabla("AttachFile").Value  ' El campo de tipos DatosAdjuntos se llama "AttachFile"
rstAdjuntos("FileData").SaveToFile LaRutaDeDestino
rstAdjuntos.Close
Set rstAdjuntos = Nothing
rstTabla.Close
Set rstTabla = Nothing

Xavi, un minyó de Terrassa

Mi web
Arriba
Nanipepe Ver desplegable
Nuevo
Nuevo


Unido: 11/Junio/2009
Localización: España
Estado: Sin conexión
Puntos: 17
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita Nanipepe Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 21/Julio/2022 a las 14:30
Muchas gracias, seguí intentándolo y al final logré sacar uno que además graba en una tabla las claves de la tabla que los contenía y el nombre del archivo guardado, lo escribo aquí por si alguien puede interesarlE
Espero que se entienda


' *****EXTRAER ADJUNTOS Y PASARLOS A DISCO

Private Sub subEXTadjuntos()
    Dim rsTB As Recordset
    Dim rsCP As Recordset
    Dim rsTBO As Recordset
    Dim strPATH As String
    Dim strNOM As String
    Dim strTIPO As String
    Dim ct As Integer, ctd As Integer
    
    strTIPO = "APTR"
    strPATH = "\\srvdtvalencia\ADMINISTRACION\ADMNIISTRACION\000_DTV-TYPSA\TEMPORALES_2022\OFE_ADJUNTOS\APTR\"
    Set rsTB = CurrentDb.OpenRecordset("OFERTAS", dbOpenForwardOnly)
    Set rsTBO = CurrentDb.OpenRecordset("OFE_ADJUNTOS", dbOpenDynaset)
    
    With rsTB
        Do Until rsTB.EOF
            ctd = 0
            Set rsCP = rsTB.Fields("DOC_APERTURA").Value
            With rsCP
                Do Until rsCP.EOF
'Debug.Print rsTB!DAT
                        ct = ct + 1
                        strNOM = rsTB!DAT & strTIPO & Format(ct, "000")
                        rsCP("FileData").SaveToFile strPATH & strNOM & "." & rsCP("FILETYPE")
                            ' AÑADE REGISTRO A LA TABLA DE ADJUNTOS
                            ctd = ctd + 1
                            rsTBO.AddNew
                            rsTBO!DAT = rsTB!DAT
                            rsTBO!EMPRESA = rsTB!EMPRESA
                            rsTBO!LINEA = ctd
                            rsTBO!TIPO = "APTR"
                            rsTBO!NOMBRE = strNOM
                            rsTBO.Update
                        rsCP.MoveNext
                Loop
            End With
            rsCP.Close
            Set rsCP = Nothing
        rsTB.MoveNext
        Loop
    End With
    rsTB.Close
    Set rsTB = Nothing
    
End Sub
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable