Attribute VB_Name = "modUtilidades"
Option Explicit

' =====================================================================
'  modUtilidades - Funciones compartidas por todas las automatizaciones
'
'  Importalo SIEMPRE junto con el modulo de la herramienta que quieras
'  usar (Alt+F11 > Archivo > Importar archivo). Contiene:
'    - GuardarEstado / RestaurarEstado: apaga el refresco de pantalla y el
'      calculo mientras trabaja la macro y lo deja como estaba.
'    - LeerConfig / ConfigLong / ConfigBool: lectura de la hoja "Config"
'      (columna A = clave, columna B = valor). Asi ninguna ruta, cuenta ni
'      asunto queda escrito en el codigo.
'    - NombreArchivoSeguro: nombre de archivo valido en Windows.
'    - ComprobarPDF: detecta PDF truncados antes de copiarlos o enviarlos.
'    - RegistroCrear / RegistroAnotar: registro TSV de lo que se ha hecho.
'    - Progreso: barra de estado como mucho una vez por segundo.
'    - RellenarPlantilla: sustituye {A}, {B}... por el valor de la columna.
'    - Aviso / Confirmar: cuadros de dialogo; con SinMensajes = SI en
'      Config no se abre ninguno (para ejecutar desde un script).
'
'  >> ADAPTAR: si tu hoja de configuracion se llama de otra forma, cambia
'     el valor por defecto del parametro "hoja" en LeerConfig.
' =====================================================================

' ---------- Estado de la aplicacion ----------
Public Type EstadoExcel
    Guardado As Boolean
    ScreenUpdating As Boolean
    EnableEvents As Boolean
    Calculation As XlCalculation
    StatusBar As Variant
    EnableCancelKey As Long
    DisplayAlerts As Boolean
End Type

Public Sub GuardarEstado(ByRef e As EstadoExcel)
    With Application
        e.ScreenUpdating = .ScreenUpdating
        e.EnableEvents = .EnableEvents
        e.Calculation = .Calculation
        e.StatusBar = .StatusBar
        e.EnableCancelKey = .EnableCancelKey
        e.DisplayAlerts = .DisplayAlerts
        e.Guardado = True
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .EnableCancelKey = xlErrorHandler
    End With
End Sub

Public Sub RestaurarEstado(ByRef e As EstadoExcel)
    If Not e.Guardado Then Exit Sub
    On Error Resume Next
    With Application
        .ScreenUpdating = e.ScreenUpdating
        .EnableEvents = e.EnableEvents
        .Calculation = e.Calculation
        .StatusBar = e.StatusBar
        .EnableCancelKey = e.EnableCancelKey
        .DisplayAlerts = e.DisplayAlerts
    End With
    On Error GoTo 0
    e.Guardado = False
End Sub

' ---------- Configuracion en hoja ----------
' La hoja "Config" tiene dos columnas: A = clave, B = valor.
' Asi ninguna ruta, cuenta o asunto queda escrito en el codigo.
Public Function LeerConfig(ByVal clave As String, Optional ByVal obligatorio As Boolean = True, _
                           Optional ByVal porDefecto As String = "", _
                           Optional ByVal hoja As String = "Config") As String
    Dim ws As Worksheet, celda As Range
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(hoja)
    On Error GoTo 0
    If ws Is Nothing Then
        If obligatorio Then Err.Raise vbObjectError + 1, , "Falta la hoja de configuracion '" & hoja & "'."
        LeerConfig = porDefecto
        Exit Function
    End If
    Set celda = ws.Columns(1).Find(What:=clave, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not celda Is Nothing Then
        If IsError(ws.Cells(celda.Row, 2).Value) Then Err.Raise vbObjectError + 2, , "Valor no valido en Config '" & clave & "'."
        LeerConfig = Trim$(CStr(ws.Cells(celda.Row, 2).Value))
    End If
    If Len(LeerConfig) = 0 Then
        If obligatorio Then Err.Raise vbObjectError + 2, , "Falta el valor de configuracion '" & clave & "' en la hoja " & hoja & "."
        LeerConfig = porDefecto
    End If
End Function

Public Function ConfigLong(ByVal clave As String, Optional ByVal porDefecto As Long = 0) As Long
    Dim v As String
    v = LeerConfig(clave, False, CStr(porDefecto))
    If IsNumeric(v) Then ConfigLong = CLng(v) Else ConfigLong = porDefecto
End Function

Public Function ConfigBool(ByVal clave As String, Optional ByVal porDefecto As Boolean = False) As Boolean
    Dim v As String
    v = UCase$(LeerConfig(clave, False, IIf(porDefecto, "SI", "NO")))
    ConfigBool = (v = "SI" Or v = "S" Or v = "TRUE" Or v = "VERDADERO" Or v = "1")
End Function

' ---------- Hojas y rangos ----------
Public Function UltimaFila(ByVal ws As Worksheet, Optional ByVal columna As Variant = 1) As Long
    UltimaFila = ws.Cells(ws.Rows.Count, columna).End(xlUp).Row
End Function

Public Function ColumnaANumero(ByVal letraONumero As String) As Long
    Dim i As Long, s As String, n As Long
    s = UCase$(Trim$(letraONumero))
    If IsNumeric(s) Then
        ColumnaANumero = CLng(s)
        Exit Function
    End If
    For i = 1 To Len(s)
        If Mid$(s, i, 1) < "A" Or Mid$(s, i, 1) > "Z" Then Err.Raise vbObjectError + 7, , "Columna no valida: " & letraONumero
        n = n * 26 + (Asc(Mid$(s, i, 1)) - 64)
    Next i
    If n < 1 Or n > 16384 Then Err.Raise vbObjectError + 7, , "Columna no valida: " & letraONumero
    ColumnaANumero = n
End Function

' ---------- Nombres de archivo ----------
' Une las partes con espacios, quita caracteres no validos en Windows y
' rechaza nombres vacios o reservados. NO trunca ni cambia identificadores.
Public Function NombreArchivoSeguro(ByVal extension As String, ParamArray partes() As Variant) As String
    Dim s As String, i As Long, c As Variant, k As Long, raiz As String
    For i = LBound(partes) To UBound(partes)
        If Len(Trim$(CStr(partes(i) & ""))) > 0 Then
            If Len(s) > 0 Then s = s & " "
            s = s & Trim$(CStr(partes(i)))
        End If
    Next i
    s = Replace(s, "/", "_")
    For Each c In Array("\", ":", "*", "?", """", "<", ">", "|")
        s = Replace(s, CStr(c), "")
    Next c
    For k = 0 To 31
        s = Replace(s, Chr$(k), "")
    Next k
    s = Trim$(s)
    Do While Right$(s, 1) = "."
        s = Left$(s, Len(s) - 1)
    Loop
    If Len(Trim$(Replace(s, ".", ""))) = 0 Then
        Err.Raise vbObjectError + 112, , "Nombre de archivo vacio o no valido."
    End If
    raiz = UCase$(Trim$(Split(s, ".")(0)))
    Select Case raiz
        Case "CON", "PRN", "AUX", "NUL", "CONIN$", "CONOUT$", _
             "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", _
             "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9"
            Err.Raise vbObjectError + 113, , "Nombre reservado por Windows: " & s
    End Select
    If Left$(extension, 1) <> "." Then extension = "." & extension
    NombreArchivoSeguro = s & extension
End Function

' ---------- Dialogos ----------
Public Function ElegirCarpeta(ByVal titulo As String, Optional ByVal inicial As String = "") As String
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        .Title = titulo
        .AllowMultiSelect = False
        If Len(inicial) > 0 Then .InitialFileName = inicial
        If .Show = -1 Then ElegirCarpeta = .SelectedItems(1)
    End With
End Function

' ---------- Comprobaciones de archivos ----------
Public Sub ComprobarArchivoExiste(ByVal fso As Object, ByVal ruta As String)
    If Not fso.FileExists(ruta) Then Err.Raise vbObjectError + 114, , "Falta el archivo: " & ruta
    If fso.GetFile(ruta).Size = 0 Then Err.Raise vbObjectError + 115, , "Archivo vacio: " & ruta
End Sub

' Comprobacion basica de truncamiento (cabecera %PDF- y %%EOF al final).
Public Sub ComprobarPDF(ByVal ruta As String)
    Dim canal As Integer, abierto As Boolean, largo As Long, cola As Long
    Dim cabecera As String, finalPDF As String, numeroError As Long, descripcionError As String
    On Error GoTo FalloPDF
    canal = FreeFile
    Open ruta For Binary Access Read As #canal
    abierto = True
    largo = LOF(canal)
    If largo < 10 Then Err.Raise vbObjectError + 214, , "PDF vacio o incompleto: " & ruta
    cabecera = Space$(5)
    Get #canal, 1, cabecera
    cola = largo
    If cola > 2048 Then cola = 2048
    finalPDF = Space$(cola)
    Get #canal, largo - cola + 1, finalPDF
    Close #canal
    abierto = False
    If cabecera <> "%PDF-" Or InStr(1, finalPDF, "%%EOF", vbBinaryCompare) = 0 Then
        Err.Raise vbObjectError + 215, , "El PDF parece incompleto: " & ruta
    End If
    Exit Sub
FalloPDF:
    numeroError = Err.Number: descripcionError = Err.Description
    On Error Resume Next
    If abierto Then Close #canal
    On Error GoTo 0
    Err.Raise numeroError, "ComprobarPDF", descripcionError
End Sub

' ---------- Registro TSV ----------
Public Sub RegistroCrear(ByVal fso As Object, ByVal ruta As String)
    Dim archivo As Object
    Set archivo = fso.CreateTextFile(ruta, False, True) ' UTF-16, Excel lo abre bien
    archivo.WriteLine "Fecha" & vbTab & "Fila" & vbTab & "Estado" & vbTab & "Correo" & vbTab & "Archivo" & vbTab & "Detalle"
    archivo.Close
End Sub

Public Sub RegistroAnotar(ByVal fso As Object, ByVal ruta As String, ByVal fila As Long, _
                          ByVal estado As String, ByVal correo As String, ByVal archivoRuta As String, ByVal detalle As String)
    Dim archivo As Object
    If Len(ruta) = 0 Then Exit Sub
    Set archivo = fso.OpenTextFile(ruta, 8, False, -1)
    archivo.WriteLine Format$(Now, "yyyy-mm-dd hh:nn:ss") & vbTab & fila & vbTab & estado & vbTab & _
        CampoTSV(correo) & vbTab & CampoTSV(archivoRuta) & vbTab & CampoTSV(detalle)
    archivo.Close
End Sub

Public Function CampoTSV(ByVal s As String) As String
    s = Replace(Replace(Replace(s, vbTab, " "), vbCr, " "), vbLf, " ")
    If Len(s) > 0 Then
        If InStr(1, "=+-@", Left$(s, 1), vbBinaryCompare) > 0 Then s = "'" & s
    End If
    CampoTSV = s
End Function

' ---------- Tiempo y progreso ----------
Public Function SegundosDesde(ByVal marca As Double) As Double
    Dim t As Double
    t = CDbl(Timer) - marca
    If t < 0 Then t = t + 86400#
    SegundosDesde = t
End Function

' Actualiza la barra de estado como mucho una vez por segundo.
Public Sub Progreso(ByVal texto As String, ByVal actual As Long, ByVal total As Long)
    Static ultimaMarca As Double
    If actual = 1 Or actual = total Or SegundosDesde(ultimaMarca) >= 1 Then
        Application.StatusBar = texto & ": " & actual & " / " & total
        ultimaMarca = CDbl(Timer)
        DoEvents
    End If
End Sub

' ---------- Outlook ----------
Public Function ObtenerOutlook() As Object
    Dim app As Object
    On Error Resume Next
    Set app = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If app Is Nothing Then Set app = CreateObject("Outlook.Application")
    Set ObtenerOutlook = app
End Function

' Sustituye {A}, {B}, {AO}... por el valor de esa columna en la fila dada.
Public Function RellenarPlantilla(ByVal plantilla As String, ByVal ws As Worksheet, ByVal fila As Long) As String
    Dim resultado As String, ini As Long, fin As Long, col As String
    resultado = plantilla
    ini = InStr(1, resultado, "{")
    Do While ini > 0
        fin = InStr(ini, resultado, "}")
        If fin = 0 Then Exit Do
        col = Mid$(resultado, ini + 1, fin - ini - 1)
        If Len(col) >= 1 And Len(col) <= 3 And Not col Like "*[!A-Za-z]*" And EsColumnaValida(col) Then
            resultado = Left$(resultado, ini - 1) & CStr(ws.Cells(fila, ColumnaANumero(col)).Value) & Mid$(resultado, fin + 1)
            ini = InStr(ini + 1, resultado, "{")
        Else
            ini = InStr(fin + 1, resultado, "{")
        End If
    Loop
    RellenarPlantilla = resultado
End Function

Private Function EsColumnaValida(ByVal col As String) As Boolean
    On Error Resume Next
    EsColumnaValida = (ColumnaANumero(col) > 0)
    On Error GoTo 0
End Function

' ---------- Mensajes ----------
' Con SinMensajes = SI en Config (util para ejecutar las macros desde un script
' o para grabar una demo) el aviso no abre un cuadro: se escribe en la barra de
' estado y en el archivo ultimo_aviso.txt junto al libro.
Public Sub Aviso(ByVal texto As String, Optional ByVal icono As Long = vbInformation)
    Dim canal As Integer
    If ConfigBool("SinMensajes", False) Then
        On Error Resume Next
        Application.StatusBar = Left$(Replace(texto, vbCrLf, " | "), 250)
        canal = FreeFile
        Open ThisWorkbook.Path & "\ultimo_aviso.txt" For Output As #canal
        Print #canal, Format$(Now, "yyyy-mm-dd hh:nn:ss")
        Print #canal, texto
        Close #canal
        On Error GoTo 0
    Else
        MsgBox texto, icono
    End If
End Sub

' Confirmacion Si/No; con SinMensajes = SI se da por aceptada.
Public Function Confirmar(ByVal texto As String, ByVal titulo As String) As Boolean
    If ConfigBool("SinMensajes", False) Then
        Confirmar = True
    Else
        Confirmar = (MsgBox(texto, vbYesNo + vbQuestion + vbDefaultButton2, titulo) = vbYes)
    End If
End Function