Anónimo
Macro que realice búsqueda en columna B si existe el archivo en carpeta externa cambie color de texto y si no lo copie a h5
Y FELIZ AÑO NUEVO para usted y su familia
Tengo una macro que contiene nombres de archivos .pdf me dice si el archivo de la celda seleccionada en la columna B existe en mi carpeta externa si lo encuentra pregunta si deseo abrirlo y si no manda mensaje de que no fue localizado
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub 'sólo se ejecutará en col B'
If Target.Row < 9 Then Exit Sub 'sólo se ejecuta a partir de la fila 9'
ChDir "C:\Users\cari\Documents\libros\"
nombre = Range("b" & ActiveCell.Row).Value
Set fso = CreateObject("scripting.filesystemobject")
If fso.fileexists(CurDir() & "\" & nombre) Then
x = MsgBox("el archivo existe. Desea abrirlo??", vbYesNo, "ATENCION")
If x = vbNo Then Exit Sub
Shell "C:\Program Files (x86)\Adobe\Reader 9.0\Reader\AcroRd32.exe " & nombre
Else: y = MsgBox("no fue localizado")
End If
End Sub
Lo que quiero ahora es que realice una búsqueda fila por fila y si encuentra el archivo cambie el color del texto de la celda en la columna B
En caso de no encontrarlo que copie toda la fila a la hoja5 del libro
Espero me puedan ayudar gracias y FELIZ AÑO NUEVO
Mis mejores deseos y bendiciones para ustedes y sus seres queridos que todos sus propósitos y metas se cumplan de la mejor manera hoy y siempre GRACIAS :3
1 Respuesta
H o l a:
Te anexo la macro
Sub RevisarArchivos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h5 = Sheets("Hoja5")
j = h5.Range("B" & Rows.Count).End(xlUp).Row + 1
For i = 9 To Range("B" & Rows.Count).End(xlUp).Row
'ChDir "C:\Users\cari\Documents\libros\"
ChDir ThisWorkbook.Path & "\"
nombre = Cells(i, "B")
Set fso = CreateObject("scripting.filesystemobject")
If fso.fileexists(CurDir() & "\" & nombre) Then
Cells(i, "B").Font.ColorIndex = 4
Else
Cells(i, "B").Font.ColorIndex = xlNone
Rows(i).Copy
h5.Cells(j, "A").PasteSpecial xlValues
j = j + 1
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
muchas Gracias y felices fiestas :3
Muy buenos días espero este teniendo un excelente inicio de semana y año
disculpe me surgieron unas dudas como podría hacerle para que me abra el archivo si solo coincide parte del texto ya que el registro en Excel se escribe completo el nombre del mismo, pero en el pdf solo se toma parte del nombre para guardarlo en la carpeta y a su vez como anexar al final del nombre guardado en columna B ".pdf" espero me pueda ayudar de antemano gracias
Con mucho gusto te ayudo con todas tus peticiones.
Crea una nueva pregunta en el tema de microsoft excel, en el desarrollo de la pregunta escribe: "para Dante Amor"
En la nueva pregunta me explicas con ejemplos qué es lo que tienes en excel y cómo se llaman los archivos.