Necesito una macro para identificar si se encuentra un archivo o no?

Se puede hacer una macro que a el escribir un numero de factura en una celda de exel la pueda buscar en una carpeta de mi pc y la identifique si esta existe o no (no importa si se pone de un color las existentes o que salga una leyenda "si existe " o algo así )

1 respuesta

Respuesta
2

.13/09/16

Buenas noches, Juan

Interpreté que los números de factura son -también- el nombre de los archivos que tienes en esa carpeta.

Si, eventualmente, hubiera entendido bien, esta rutina de VBA te dirá si encontró esa factura/archvio en la carpeta que le indiques.

Accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo - si no tuvieras uno ya- y pega el siguiente código:

Sub BuscaFact()
'---- Variables modificables:
'=== JUAN: escribe aquí el nombre de la carpeta donde debe buscar tu archivo:
LaCarpeta = "C:\Users\JASAMPEDRO"
Exten = "xls" 'extensión del archivo, blanco si no lo sabes
'---- Si lo fuese a tomar de una celda, indicalo aquí:  
LaCelda = "D4"
'---- fin Variables
'
'---- inicio de rutina:  
NombArch = InputBox("ingresar NUMERO de factura" & Chr(10) & "a buscar en " & LaCarpeta & Chr(10) & "(vacio para salir sin hacer nada)", "BUSQUEDA DE FACTURA")
'---- Si lo fuese a tomar de una celda, anula la línea anterior y quita el apóstrofo de la linea siguiente:  
'NombArch = Range(LaCelda).Value  
If Len(NombArch) Then
    NombArchivo = NombArch & "." & Exten & "*"
    'Control de Existencia del archivo  
    chk = Dir(LaCarpeta & "\" & NombArchivo)
    If chk = "" Then
        ElMensaje = "NO se encontró la factura " & NombArch & Chr(10) & _
        "en la carpeta " & LaCarpeta
        ElTitulo = "FACTURA NO ENCONTRADA!"
        TipoMens = vbCritical
        MsgBox "nosta"
    Else
        ElMensaje = "La factura " & NombArch & " fue encontrada " & Chr(10) & _
        "en la carpeta " & LaCarpeta
        TipoMens = vbInformation
        ElTitulo = "FACTURA ENCONTRADA!"
    End If
    MsgBox ElMensaje, TipoMens, ElTitulo
End If
End Sub

Una vez que completes las variables donde te indico, así como está, el procedimiento inicia con una cuadro de diálogo para que escribas el número de la factura a buscar.

Si te fuese más práctico que tome ese dato de una celda, puedes adaptarlo, anulando la linea que inicia con NombArch = InputBox("ingr...

Basta colocarle un apóstrofo ( ' ) al inicio para que no se ejecute.

Luego quita ese símbolo de la linea:

'NombArch = Range(LaCelda).Value  

Listo, puedes cerrar el editor de VBA

Pruebala y dime si es lo que necesitabas. Caso contrario, coméntame qué faltó o estuvo errado.

Un abrazo

Fernando

(Buenos Aires, Argentina)

.

hola Fernando ......

seguí a pie de el renglón las indicaciones y me sale el recuadro para que busque el documento pero no lo encuentra siendo que ese documento si existe el la carpeta , siendo que la carpeta en que esta ubicado es "C:\prueba\"  y uno de los numero de factura es 86505103  y a lo que vi el VBA que me proporcionaste es solo buscarla y pues quisiera que se identifique de un color si si esta o no

 saludos .....

Fernando si ya funciono excelente pero no se si se pueda que aparte de que me de el aviso de que si se encuentra me pueda iluminar la celda de las que si esta y las que no ...

.

Ok, Juan

Me parece entender que tienes una lista de facturas a buscar en esa carpeta.

En tal caso, sería poco práctico que apareciera un mensaje por cada una.

Por ello, esta variante de la rutina, barre toda tu lista y marca con un color la celda y, además, escribe en la celda a su derecha si fue encontrada o no:

Sub BuscaFactL()
'---- Variables modificables:
'=== JUAN: escribe aquí el nombre de la carpeta donde debe buscar tu archivo:
LaCarpeta = "C:\Users\JASAMPEDRO"
Exten = "xls" 'extensión del archivo, blanco si no lo sabes
LaCelda = "D4" 'Donde inicia el listado
ElColor = 33
'---- fin Variables
'
'---- inicio de rutina:
'  
UltFila = Range(LaCelda).CurrentRegion.Rows.Count - 1
For LaFila = 0 To UltFila
NombArch = Range(LaCelda).Offset(LaFila).Value
    NombArchivo = NombArch & "." & Exten & "*"
    'Control de Existencia del archivo
    chk = Dir(LaCarpeta & "\" & NombArchivo)
    If chk = "" Then
        Range(LaCelda).Offset(LaFila).Interior.ColorIndex = 0
        Range(LaCelda).Offset(LaFila, 1).Value = "No encontrado"
    Else
        Range(LaCelda).Offset(LaFila).Interior.ColorIndex = ElColor
        Range(LaCelda).Offset(LaFila, 1).Value = "Encontrado"
    End If
Next
End Sub

Espero que te funcione bien y sea lo que buscabas.

Un abrazo

Fernando

.

funciono excelente muchas gracias te lo súper agradezco Fernando.....

saludos un abrazo ,,,,,,, 

.

Un placer ayudar!

Abrazo

Fernando

Hola Fernando de nuevo molestándote trate de implementar de nuevo la macro en otro archivo y no  funciona ya ice el cambio de ruta y la celda pero me aparece un error (error 1004 en tiempo de ejecución ) no se si me puedas ayudar o que le tenga que cambiar

gracias saludos

.

Buenas, Juan

Antes que nada, me disculpo por la demora. La semana pasada estuve fuera y no accedía a este sitio.

En realidad el error 1004 puede darse por múltiples situaciones, aunque ninguna que pueda asociarse a una rutina como la que te envié.

Probablemente tenga que ver con alguna particularidad de los archivos que estás buscando,

Por caso protecciones o atributos de ocultos. En ocasiones cuando intentamos abrir un archivo de MS Excel ubicado en la unidad de red. Tal vez tengas problemas de permisos de acceso a ella.

En cualquier caso, podrías indicarme cómo es la ruta completa que pusiste en la variable LaCarpeta.

Saludos

Fernando

.

hola fernando mira te mando la ruta y todo..

Sub BuscaFactL()
'---- Variables modificables:
'=== JUAN: escribe aquí el nombre de la carpeta donde debe buscar tu archivo:
LaCarpeta = "C:\acuses2016\"
Exten = "pdf"
LaCelda = "e2" 'Donde inicia el listado
ElColor = 33
'---- fin Variables
'
'---- inicio de rutina:
'
UltFila = Range(LaCelda).CurrentRegion.Rows.Count - 1
For LaFila = 0 To UltFila
NombArch = Range(LaCelda).Offset(LaFila).Value
    NombArchivo = NombArch & "." & Exten & "*"
    'Control de Existencia del archivo
    chk = Dir(LaCarpeta & "\" & NombArchivo)
    If chk = "" Then
        Range(LaCelda).Offset(LaFila).Interior.ColorIndex = 0
        Range(LaCelda).Offset(LaFila, 1).Value = "No encontrado"
    Else
        Range(LaCelda).Offset(LaFila).Interior.ColorIndex = ElColor
        Range(LaCelda).Offset(LaFila, 1).Value = "Encontrado"
    End If
Next
End Sub

si la copio de este sitio me marca el error que te comente pero si lo copio de el archivo que tengo solo no me funciona

.

Buenas, Juan

Reproduje tu ejemplo y me funcionó OK.

Sólo que noté que en la variable LaCarpeta colocaste una barra invertida al final. Fijate en mi ejemplo original que no la tiene. Como la rutina agrega esa barra en el proceso, queda duplicada y por ello no encuentra ese directorio.

Eso es un problema que pudo haber generado el error 1004.

La otra observación que podría hacerte es que si en el listado ya tiene la extensión (.pdf), lo dá como no encontrado, porque la rutina le agrega -nuevamente- la extensión al final.

He adaptado la rutina anterior para que resuelva ambas situaciones. Esto es, si la variable de la carpeta tiene o no una barra al final o el nombre del archivo en la lista tiene o no la extensión, la macro se adapta a la situación.

Pegando esta versión sobre la anterior, debería funcionar apropiadamente:

Sub BuscaFactL()
'---- Variables modificables:
'=== JUAN: escribe aquí el nombre de la carpeta donde debe buscar tu archivo:
LaCarpeta = "C:\acuses2016"
Exten = "pdf"
LaCelda = "e2" 'Donde inicia el listado
ElColor = 33
'---- fin Variables
'
'---- inicio de rutina:
'  
UltFila = Range(LaCelda).CurrentRegion.Rows.Count - 1
LaCarpeta = Trim(LaCarpeta)
LaCarpeta = LaCarpeta & IIf(Right(LaCarpeta, 1) = "\", "", "\")
For LaFila = 0 To UltFila
NombArch = Trim(Range(LaCelda).Offset(LaFila).Value)
    NombArchivo = NombArch & IIf(UCase(Right(NombArch, Len(Exten))) = UCase(Exten), "", "." & Exten & "*")
    'Control de Existencia del archivo  
    chk = Dir(LaCarpeta & NombArchivo)
    If chk = "" Then
        Range(LaCelda).Offset(LaFila).Interior.ColorIndex = 0
        Range(LaCelda).Offset(LaFila, 1).Value = "No encontrado"
    Else
        Range(LaCelda).Offset(LaFila).Interior.ColorIndex = ElColor
        Range(LaCelda).Offset(LaFila, 1).Value = "Encontrado"
    End If
Next
End Sub

Espero que así sea.

Un abrazo

Fernando

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas