I think i solved it, i have to do some checks but... it seems it works:

changed shellzip function to:

Code:
Public Function ShellZip(ByRef Source As String, ByRef DestZip As String) As Boolean

    CreateNewZip DestZip

    On Error Resume Next
        With CreateObject("Shell.Application")  'Late-bound
            'With New Shell                          'Referenced
            If Right$(Source, 1&) = "\" Then
                .NameSpace(CVar(DestZip)).CopyHere .NameSpace(CVar(Source)).Items
              Else
                .NameSpace(CVar(DestZip)).CopyHere CVar(Source)
            End If
        End With
       
       ' ShellZip = (Err = 0&)
        
         ' Esperar a que termine el proceso de compresión
        Do While Not WaitForZipCompletion(DestZip)
            ShellZip = False
        Loop
    
        Pausa 2
    
        ShellZip = True
        
    On Error GoTo 0

End Function

Created a new function:

Code:
Private Function WaitForZipCompletion(ByRef DestZip As String) As Boolean
    Dim objShell As Object
    Dim objZip As Object
    Dim startTime As Single

    Set objShell = CreateObject("Shell.Application")
    Set objZip = objShell.NameSpace(CVar(DestZip))

    ' Tiempo máximo de espera en segundos
    Const TIMEOUT_SECONDS As Single = 60
    startTime = Timer

    Do
        ' Verifica si el ZIP contiene archivos (Items > 0)
        If objZip.Items.count > 0 Then
            WaitForZipCompletion = True
            Exit Function
        End If

        ' Salir si se supera el tiempo límite
        If Timer - startTime > TIMEOUT_SECONDS Then Exit Do
        DoEvents  ' Permitir que el sistema procese otros eventos
    Loop

    WaitForZipCompletion = False
End Function