MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Compactar Pasta completa provocando pausa no código enquanto o WinRar estiver ativo

    HARYSOHN
    HARYSOHN
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12227
    Registrado : 01/03/2011

    Compactar Pasta completa provocando pausa no código enquanto o WinRar estiver ativo Empty Compactar Pasta completa provocando pausa no código enquanto o WinRar estiver ativo

    Mensagem  HARYSOHN em 11/9/2013, 22:07


    Este exemplo de código provoca uma checagem a cada 5 segundos verificando se o processo de compactação ainda está ativo
    Proseguindo o código caso esteja finalizado.
    O tempo pode ser alterado conforme vossas necessidades



    Realmente.. a função resolveu completamente a minha necessidade:

    Nas declarações do módulo:
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As String) As Long


    Função:

    Function ProgramaAtivo(NomePrg As String) As Boolean
    If FindWindow(0, NomePrg) <> 0 Then
        ProgramaAtivo = True
    Else
        ProgramaAtivo = False
    End If
    End Function



    E ao chamar a função vou provocando pausas de 5 segundos a cada verificação caso o winRar esteja aberto:


                Dim strOrigem As String
                'Me.CompactaFotos
                shell "cmd /c taskkill -f -im WinRar.exe *32", vbHide
                strOrigem = CurrentProject.path & "\Fotos\Fotos.rar"
                Compri = shell(strLocalWinRar & "\Winrar\WinRAR.EXE a " & Chr(34) & strOrigem & Chr(34) & " " & Chr(34) & CurrentProject.path & "\Fotos" & Chr(34), vbHide)
    Volta:
                If ProgramaAtivo("WinRar") = True Then
                    Pause (5)
                    GoTo Volta
                End If



    Cumprimentos.

      Data/hora atual: 29/11/2020, 15:49