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

Tema cerradoBuscar archivos jpg

 Responder Responder
Autor
Mensaje
Quimets Ver desplegable
Nuevo
Nuevo


Unido: 21/Mayo/2020
Localización: 08396
Estado: Sin conexión
Puntos: 3
Enlace directo a este mensaje Tema: Buscar archivos jpg
    Enviado: 21/Mayo/2020 a las 14:03
Buenos días,

Les detallo la información, hasta ahora no he conseguido ejecutarlo:

Tengo un campo llamado "DA": se trata de un campo donde pongo manualmente el numero alfanumérico de un albarán interno que relaciona un albaran del proveedor "X" con una autorización interna. Cada DA se escanea y se guarda en formato jpg dentro de la carpeta del proveedor. 

Dentro de la carpeta DA, digamos que esta ubicada en: C:\DA, tengo un montón de carpetas dentro, una para cada proveedor. Y dentro de cada una de estas, hay los documentos escaneados solo de ese proveedor.

Lo que tengo que conseguir es que cuando ponga el código alfanumérico en el campo DA, en "después de actualizar", una función me pueda mostrar el nombre de la carpeta del proveedor (para ponerla en un campo llamado 'prov') para saber a quien corresponde el documento, y que me de un link donde pueda clicar y ver el documento escaneado (este link también lo guardaría en un campo para que quede guardado). 

He probado opciones como devolver la ruta del archivo y escoger o capturar carpeta, pero no lo consigo, y otras funciones que muestran no consigo entenderlas.

Muchas gracias de antemano.
Saludos

Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 12830
Enlace directo a este mensaje Enviado: 21/Mayo/2020 a las 14:33
Hola Quiments y bienvenido a foro,

Entiendo que quieres localizar un fichero jpg dentro de un árbol de carpetas dado. A partir de la ruta, extraer el nombre del proveedor..

En un módulo independiente:

Option Compare Database
Option Explicit


#If Win64 Then
    Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp" (ByVal rootpath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As LongPtr
#Else
    Private Declare Function SearchTreeForFile Lib "imagehlp" (ByVal rootpath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
#End If


Public Type udtFileSearch
    FileToSearch            As String
    InitialPath             As String
    Found                   As Boolean
    FullPathFounded         As String
    PathFounded             As String
End Type
Public uFileSearch          As udtFileSearch



Function BuscarArchivo()
    On Error GoTo ErrorHandler
    
    Dim strRuta As String

    strRuta = String(260, vbNullChar)

    ' Si no tenemos InitialPath, asumimos C:\
    If uFileSearch.InitialPath = "" Then
        uFileSearch.InitialPath = "C:\"
    End If

    If SearchTreeForFile(uFileSearch.InitialPath, uFileSearch.FileToSearch, strRuta) Then
        uFileSearch.Found = True
        uFileSearch.FullPathFounded = Left$(strRuta, InStr(strRuta, vbNullChar) - 1)
        uFileSearch.PathFounded = Left$(strRuta, InStrRev(strRuta, "\") - 1)
    Else
        uFileSearch.Found = False
        uFileSearch.FullPathFounded = ""
        uFileSearch.PathFounded = ""
    End If


ExitProcedure:
    Err.Clear
    Exit Function

ErrorHandler:
    Select Case Err.Number
        Case 0
        Case Else
            MsgBox "Error " & Err.Number & " - " & Err.Description & vbNewLine & _
                    "Procedimiento: BuscarArchivo" & vbNewLine & _
                    "Módulo: " & Application.VBE.ActiveCodePane.CodeModule.Name, vbCritical, "AVISO"
            Resume ExitProcedure
    End Select
End Function

Para utilizarla:

uFileSearch.FileToSearch = "codigoalfanumerico.jpg"
uFileSearch.InitialPath = "C:\DA"
BuscarArchivo
If uFileSearch.Found Then
  ' Puedes recuperar la ruta (uFileSearch.PathFounded) o la ruta con el nombre (uFileSearch.FullPathFounded)
Else
  MsgBox "No encontrado"
End If

Con la ruta recuperada y un poco de tratamiento de textos, se obtiene el nombre del proveedor.

Adáptalo a tus necesidades.

Un saludo
Xavi, un minyó de Terrassa

Mi web
Arriba
rokoko Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 16/Febrero/2008
Localización: Pamplona
Estado: Sin conexión
Puntos: 2495
Enlace directo a este mensaje Enviado: 21/Mayo/2020 a las 14:35
Yo sin probar no me suele salir, no tengo la capacidad de los pros para escribir al vuelo jaja

Para abrir un archivo podria ser algo asi.
Application.FollowHyperlink "C:\DA\" & Me.DA

Para carpeta
Application.FollowHyperlink "C:\DA"
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 12830
Enlace directo a este mensaje Enviado: 21/Mayo/2020 a las 14:36
rokoko, o tu o yo lo hemos entendido al revés...
Xavi, un minyó de Terrassa

Mi web
Arriba
Mihura Ver desplegable
Administrador
Administrador
Avatar

Unido: 06/Mayo/2005
Localización: En la dehesa
Estado: Sin conexión
Puntos: 11592
Enlace directo a este mensaje Enviado: 21/Mayo/2020 a las 15:47
Este SearchTreeForFile no me lo sabía yo ... Thumbs Up
Jesús Mansilla Castells.
Saludos desde Móstoles.

Access Aplicaciones
Tecsys.es
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 12830
Enlace directo a este mensaje Enviado: 21/Mayo/2020 a las 15:57
Siempre se aprende algo.

Yo lo utilizo para localizar programas. En concreto lo necesite para saber si está el 7-zip en la máquina y poder automatizar un fichero comprimido con password.

Un saludo
Xavi, un minyó de Terrassa

Mi web
Arriba
Quimets Ver desplegable
Nuevo
Nuevo


Unido: 21/Mayo/2020
Localización: 08396
Estado: Sin conexión
Puntos: 3
Enlace directo a este mensaje Enviado: 22/Mayo/2020 a las 21:08
Buenas!

Ya lo tengo, gracias a sus aportaciones y a la inestimable ayuda de un amigo siempre dispuesto a ayudar, hemos conseguido lo que buscaba. A continuación les detallo el código que finalmente hemos utilizado:


** En un módulo independiente:

Option Compare Database
Option Explicit


#If Win64 Then
    Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp" (ByVal rootpath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As LongPtr
#Else
    Private Declare Function SearchTreeForFile Lib "imagehlp" (ByVal rootpath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
#End If


Public Type udtFileSearch
    FileToSearch            As String
    InitialPath             As String
    Found                   As Boolean
    FullPathFounded         As String
    PathFounded             As String
End Type
Public uFileSearch          As udtFileSearch


Function BuscarArchivo()
    On Error GoTo ErrorHandler
    
    Dim strRuta As String

    strRuta = String(260, vbNullChar)

    ' Si no tenemos InitialPath, asumimos C:\
    If uFileSearch.InitialPath = "" Then
        uFileSearch.InitialPath = "C:\"
    End If

    If SearchTreeForFile(uFileSearch.InitialPath, uFileSearch.FileToSearch, strRuta) Then
        uFileSearch.Found = True
        uFileSearch.FullPathFounded = Left$(strRuta, InStr(strRuta, vbNullChar) - 1)
        uFileSearch.PathFounded = Left$(strRuta, InStrRev(strRuta, "\") - 1)
    Else
        uFileSearch.Found = False
        uFileSearch.FullPathFounded = ""
        uFileSearch.PathFounded = ""
    End If


ExitProcedure:
    Err.Clear
    Exit Function

ErrorHandler:
    Select Case Err.Number
        Case 0
        Case Else
            MsgBox "Error " & Err.Number & " - " & Err.Description & vbNewLine & _
                    "Procedimiento: BuscarArchivo" & vbNewLine & _
                    "Módulo: " & Application.VBE.ActiveCodePane.CodeModule.Name, vbCritical, "AVISO"
            Resume ExitProcedure
    End Select
End Function


** Seguidamente, en el campo "DA", en el evento 'después de actualizar' hemos escrito:

    uFileSearch.FileToSearch = DA & ".jpg"
    uFileSearch.InitialPath = "C:\DA"
    
    BuscarArchivo
    
    If uFileSearch.Found Then
        Dim rutainicial As String
        Dim rutatrobat As String
        Dim temp As String
        
        rutainicial = uFileSearch.InitialPath
        rutatrobat = uFileSearch.PathFounded
                
        proveidor = Right$(rutatrobat, Len(rutatrobat) - Len(rutainicial) - 1)
        temp = "file:///" & uFileSearch.FullPathFounded
        link = temp
        
    Else
        MsgBox "No encontrado"
    End If


** Finalmente, para poder visualizar el archivo JPG, hemos creado un botón y en el evento 'al hacer clic' hemos escrito:

    Application.FollowHyperlink link

-------

Y ya está!! Funciona muy bien, el campo "proveedor" se rellena con el nombre de la carpeta donde hay el DA, y el botón sirve para abrir el archivo JPG.

Muchas gracias por su ayuda!!

Saludos
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable