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
.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
.
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
.
- Compartir respuesta