Attribute VB_Name = "modBuscarPDFs"
Option Explicit

' =====================================================================
'  modBuscarPDFs - Comprobar que registros tienen ya su archivo
'
'  QUE HACE
'    Recorre una columna de la hoja (codigos de cliente, expedientes,
'    pedidos, DNI, referencias...) y, para cada valor, busca en una carpeta
'    un archivo cuyo nombre CONTENGA ese texto. Escribe tres columnas:
'    estado (Encontrado / No encontrado), numero de coincidencias y nombre
'    del primer archivo encontrado.
'
'  COMO USARLA
'    1. Importa modUtilidades.bas y este modulo en el editor de VBA
'       (Alt+F11 > Archivo > Importar archivo). Guarda el libro como .xlsm.
'    2. Crea una hoja "Config" con dos columnas (A = clave, B = valor):
'         CarpetaBusqueda     C:\Documentos\Contratos      (obligatoria)
'         HojaBusqueda        Registros                    (obligatoria)
'         ColumnaBusqueda     A        columna con el texto a buscar
'         FilaInicial         2        primera fila con datos
'         ColumnaResultado    H        primera de las 3 columnas de salida
'                                      (vacio = la siguiente a la ultima usada)
'         ExtensionArchivo    pdf      vacio = cualquier extension
'         IncluirSubcarpetas  NO       SI para recorrer subcarpetas
'    3. Ejecuta la macro BuscarArchivos (Alt+F8).
'
'  POR QUE ES RAPIDA
'    Lee la carpeta UNA sola vez y compara en memoria. Con 1.000 filas
'    sobre una carpeta de red u OneDrive tarda menos de un segundo; la
'    version habitual (un Dir por fila) tardaba minutos.
'
'  PARA ADAPTARLA  (busca los comentarios ">> ADAPTAR" en el codigo)
'    - Comparar solo el principio del nombre en vez de "contiene".
'    - Exigir coincidencia exacta del nombre sin extension.
'    - Colorear las filas "No encontrado".
'  Requiere: modUtilidades.
' =====================================================================

Public Sub BuscarArchivos()
    Dim ws As Worksheet, fso As Object, carpeta As String, est As EstadoExcel
    Dim colBusqueda As Long, colResultado As Long, filaIni As Long, filaFin As Long, extension As String
    Dim valores As Variant, resultados() As Variant, nombres() As String, nombresReales() As String, totalArchivos As Long
    Dim i As Long, j As Long, texto As String, coincidencias As Long, primero As String

    On Error GoTo Fallo
    carpeta = LeerConfig("CarpetaBusqueda")
    Set ws = ThisWorkbook.Worksheets(LeerConfig("HojaBusqueda"))
    colBusqueda = ColumnaANumero(LeerConfig("ColumnaBusqueda", False, "A"))
    If Len(LeerConfig("ColumnaResultado", False)) > 0 Then
        colResultado = ColumnaANumero(LeerConfig("ColumnaResultado", False))
    Else
        colResultado = ws.UsedRange.Column + ws.UsedRange.Columns.Count ' la siguiente a la ultima usada
    End If
    filaIni = ConfigLong("FilaInicial", 2)
    extension = LCase$(Replace(LeerConfig("ExtensionArchivo", False, "pdf"), ".", ""))
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(carpeta) Then Err.Raise vbObjectError + 300, , "No existe la carpeta: " & carpeta

    filaFin = UltimaFila(ws, colBusqueda)
    If filaFin < filaIni Then
        Aviso "No hay valores que buscar en la columna " & colBusqueda & ".", vbInformation
        Exit Sub
    End If

    GuardarEstado est
    Application.StatusBar = "Leyendo la carpeta..."
    ReDim nombres(1 To 1024): ReDim nombresReales(1 To 1024)
    ListarArchivos fso, fso.GetFolder(carpeta), extension, nombres, nombresReales, totalArchivos, ConfigBool("IncluirSubcarpetas", False)

    valores = ws.Range(ws.Cells(filaIni, colBusqueda), ws.Cells(filaFin, colBusqueda)).Value
    If Not IsArray(valores) Then valores = ws.Range(ws.Cells(filaIni, colBusqueda), ws.Cells(filaFin + 1, colBusqueda)).Value ' una sola fila: forzar array 2D
    ReDim resultados(1 To filaFin - filaIni + 1, 1 To 3)
    For i = 1 To UBound(resultados, 1)
        If IsError(valores(i, 1)) Then texto = "" Else texto = LCase$(Trim$(CStr(valores(i, 1))))
        If Len(texto) > 0 Then
            coincidencias = 0: primero = ""
            For j = 1 To totalArchivos
                ' >> ADAPTAR: criterio de coincidencia. Ahora: el nombre CONTIENE el texto.
                '    Solo al principio del nombre:   If Left$(nombres(j), Len(texto)) = texto Then
                '    Nombre exacto sin extension:    If fso.GetBaseName(nombres(j)) = texto Then
                If InStr(1, nombres(j), texto, vbBinaryCompare) > 0 Then
                    coincidencias = coincidencias + 1
                    If Len(primero) = 0 Then primero = nombresReales(j)
                End If
            Next j
            resultados(i, 1) = IIf(coincidencias > 0, "Encontrado", "No encontrado")
            resultados(i, 2) = coincidencias
            resultados(i, 3) = primero
        End If
        If i Mod 200 = 0 Then Progreso "Comprobando", i, UBound(resultados, 1)
    Next i
    ws.Cells(filaIni, colResultado).Resize(UBound(resultados, 1), 3).Value = resultados
    ' >> ADAPTAR: para resaltar las filas sin archivo, descomenta estas lineas:
    ' For i = 1 To UBound(resultados, 1)
    '     If resultados(i, 1) = "No encontrado" Then ws.Rows(filaIni + i - 1).Interior.Color = RGB(255, 199, 206)
    ' Next i
    RestaurarEstado est
    Aviso "Comprobadas " & UBound(resultados, 1) & " filas contra " & totalArchivos & " archivos." & vbCrLf & _
           "Resultado en las columnas " & colResultado & " a " & colResultado + 2 & " (estado, coincidencias, primer archivo).", vbInformation
    Exit Sub
Fallo:
    RestaurarEstado est
    Aviso "Error " & Err.Number & ": " & Err.Description, vbExclamation
End Sub

' Lista los archivos de la carpeta (y subcarpetas si se pide) con la extension
' indicada (vacia = todos). Guarda el nombre en minusculas para comparar sin
' distinguir mayusculas, y el nombre real para escribirlo en la hoja.
Private Sub ListarArchivos(ByVal fso As Object, ByVal carpeta As Object, ByVal extension As String, ByRef nombres() As String, _
                           ByRef nombresReales() As String, ByRef total As Long, ByVal recursivo As Boolean)
    Dim f As Object, sub1 As Object
    For Each f In carpeta.Files
        If Len(extension) = 0 Or LCase$(fso.GetExtensionName(f.Name)) = extension Then
            total = total + 1
            If total > UBound(nombres) Then
                ReDim Preserve nombres(1 To UBound(nombres) * 2)
                ReDim Preserve nombresReales(1 To UBound(nombresReales) * 2)
            End If
            nombres(total) = LCase$(f.Name)
            nombresReales(total) = f.Name
        End If
    Next f
    If recursivo Then
        For Each sub1 In carpeta.SubFolders
            ListarArchivos fso, sub1, extension, nombres, nombresReales, total, True
        Next sub1
    End If
End Sub