MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Sab Abr 10, 2021 8:57 am

    Boa tarde Amigos

    Na rotina abaixo que deteta qual o Office 32 ou 64 como, unir os dois código e ler o que necessita.
    Códigos a unir:

    Porque ao ser executada a que estiver primeiro é que conta, se a outra estiver desativada.

    Caso nenhuma estiver desativada não comprime

    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
     'Windows 10 64 - winrar 64 - Office 2013 32

          If Len(Dir("PROGRAMFILES") & "\Winrar\WinRar.EXE") & "" > 0 Then
         
           WinRarPath = "C:\Program Files\WinRar\"
       End If

     '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
      'Windows 10 64 - winrar 64 - Office 2016 64
     
      If Len(Dir("C:\Program Files (x86)\") & "Winrar\WinRAR.EXE") & "" > 0 Then
         
            WinRarPath = "C:\Program Files (x86)\WinRar\"
       End If
       
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$


    Rotina completa abaixo:

    Sub ComprimePastaComWinRar()

    Dim Msg As String
    On Error GoTo 1

    '*******************************************
       Dim FSO As Object
       Dim FromPath As String
       Dim ToPath As String
       Dim WinRarPath As String 'Localização do WinRar.exe
       Dim RarIt As String 'Instrução de linha de comando
       Dim SourceDir As String 'O diretório de origem
       Dim DestDir As String 'O diretório de destino
       Dim DestRarName As String
       Dim Dest As String 'Caminho de destino concatenado
       FromPath = Me!CaminhoEscolhido
       ToPath = Me!CaminhoEscolhido
       'inicia a criação da pasta
       Set fs = CreateObject("Scripting.FileSystemObject")
       'se a pasta existir, deleta
       
          If Right(FromPath, 1) = "\" Then
            FromPath = Left(FromPath, Len(FromPath) - 1)
       End If
       If Right(ToPath, 1) = "\" Then
           ToPath = Left(ToPath, Len(ToPath) - 1)
       End If
       Set FSO = CreateObject("scripting.filesystemobject")
       If FSO.FolderExists(FromPath) = False Then
           MsgBox FromPath & " Não Existe."
           Exit Sub
       End If
       'copia
       FSO.CopyFolder Source:=FromPath, Destination:=ToPath
       

         '*** Verifica se existe instalação do WinRar ***

    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
     'Windows 10 64 - winrar 64 - Office 2013 32

          If Len(Dir("PROGRAMFILES") & "\Winrar\WinRar.EXE") & "" > 0 Then
         
           WinRarPath = "C:\Program Files\WinRar\"
       End If

     '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
      'Windows 10 64 - winrar 64 - Office 2016 64
     
      If Len(Dir("C:\Program Files (x86)\") & "Winrar\WinRAR.EXE") & "" > 0 Then
         
            WinRarPath = "C:\Program Files (x86)\WinRar\"
       End If
       
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
       

       SourceDir = Me.CaminhoEscolhido

        'Verifica se a Pasta tem espaços nos nomes
       If InStr(1, SourceDir, " ", vbTextCompare) <> 0 Then SourceDir = Chr(34) & SourceDir & Chr(34)
       
       'Letra do Drive de destino
       DestDir = Me.CaminhoEscolhido
       
     
       If Dir(DestDir, vbDirectory) = "" Then MkDir DestDir
        DestRarName = "Backup.Rar"
        Dest = DestDir & "\" & DestRarName

       If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
       
              RarIt = shell(WinRarPath & "Winrar.exe a -r " & Dest & " " & SourceDir, vbHide)
       
        MsgBox "Backup Complecto Criado com Sucesso...", vbInformation, "" & DLookup("[Programa]", "Proprietario") & " " & DLookup("[Tipo]", "Proprietario")

           Me.Rótulo11.Caption = "A Compactar ..."
    volta:
               If ProgramaAtivo("WinRar") = True Then
                   Pause (5)
                   GoTo volta
               End If

    Call Comando25_Click


    Exit_1:
       DoCmd.Hourglass False
       DoCmd.Echo True
       Exit Sub

    1 A:
       DoCmd.Hourglass False
       DoCmd.Echo True
       Msg = "Erro # " & Str(Err.Number) & " gerado na " & Err.Source _
           & vbNewLine & vbNewLine & "Descrição: " & Err.Description _
           & vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
       MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", Err.HelpFile, Err.HelpContext
       Resume Exit_1

    End Sub

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Sab Abr 10, 2021 2:38 pm

    Olá Assis,

    Vou dar o simples, eu uso desta forma para obter e verificar se tem WinRar:
    Código:
    Public Function pathWinRar() As String
    'Álvaro Teixeira (ahteixeira) 2021
    'Obter caminho do WinRar, para verificar fazer algo assim:
    '   If Len(pathWinRar() & "") > 0 Then  ...
    'Pode ser necessária referencia a "Microsoft Scripting Runtime"
        On Error Resume Next
        Dim WSHShell
        Set WSHShell = CreateObject("WScript.Shell")
        pathWinRar = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRar.EXE\")
    End Function

    Se quiser usar desta forma é só ajustar o seu código.

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Sab Abr 10, 2021 3:22 pm

    Teixeira

    Como chamar a sua dica ?
    A sua dica tem que estar num módulo, ou pode estar no mesmo formulário onde está a minha rotina ?

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Sab Abr 10, 2021 3:54 pm

    Olá Assis,

    Ela está "Public Function" para ser colocada num modulo e poder ser utilizada em varios formularios, etc.
    Se no seu projeto só vai usar num determinado form, pode colocar nesse mesmo e alterar para "private" ou retirar o "public".

    Abraço
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Sab Abr 10, 2021 6:27 pm

    Olá Assis,

    Lebrei deste excelente exemplo do DamascenoJr, já pronto:
    https://www.maximoaccess.com/t38668-zipar-pastas-e-arquivos-com-o-winrar

    Fica mais esta opção.

    Abraço
    Noobezinho
    Noobezinho
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4121
    Registrado : 29/06/2012

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Noobezinho Sab Abr 10, 2021 6:36 pm

    Assis

    Se analisasse o código enviado pelo Álvaro,

    saberia onde coloca-lo. Twisted Evil

    Balem


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...


    Ajude a ser ajudado:
    Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
    Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
    sem precisar procurar o mesmo.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2816
    Registrado : 21/11/2016

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  DamascenoJr. Sab Abr 10, 2021 9:38 pm

    Assis, talvez uma releitura de um tópico de sua autoria também ajude em algo.

    https://www.maximoaccess.com/t37973-resolvidoverificar-se-existe-winrar-exe-no-windows-64-e-32-bit


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    FranklinJSP
    FranklinJSP
    Avançado
    Avançado

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Anónimo
    Mensagens : 440
    Registrado : 25/02/2016

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  FranklinJSP Sab Abr 10, 2021 10:32 pm

    Boa noite Assis!

    Não seria melhor usar a versão de linha de comando do Winrar.
    Vc não precisaria saber se o Winrar está ou não instalado, é um arquivo de apenas 400KB, que pode ir na pasta do seu sistema. Funciona em 32 e 64 bits

    Saludos


    .................................................................................
    Meu Português não é muito bom,
    mas eu gosto de colaborar... em qualquer idioma
    Smile "Access... minha paixão"
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 5:24 am

    Bom dia Franklin

    O meu problema não é saber se tem ou não WinRar instalado.

    O meu problema é ter que ter duas bases de dados iguais a funcionar em 32 e 64, mas com o sistema de Backup diferente.

    Isso obriga-me a sempre que fizer uma alteração no 32 ter que fazer as mesmas alterações no 64.


    Se eu estou no Office 32 eu uso o código abaixo e tudo sai perfeito. Copia para onde eu quero a pasta toda, e no fim compacta tudo.

    'Windows 10 64 - winrar 64 - Office 2013 32

         If Len(Dir("PROGRAMFILES") & "\Winrar\WinRar.EXE") & "" > 0 Then
       
          WinRarPath = "C:\Program Files\WinRar\"
      End If

    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$


    Se eu estou no Office 64 eu uso o código abaixo e tudo sai perfeito. Copia para onde eu quero a pasta toda, e no fim compacta tudo.

     'Windows 10 64 - winrar 64 - Office 2016 64

     If Len(Dir("C:\Program Files (x86)\") & "Winrar\WinRAR.EXE") & "" > 0 Then
       
           WinRarPath = "C:\Program Files (x86)\WinRar\"
      End If
     
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

    Diz o Franklin ...

    Não seria melhor usar a versão de linha de comando do Winrar. ----------> qual é esta esta linha e como aplicar na minha rotina da mensagem Nº 1?

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    Noobezinho
    Noobezinho
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4121
    Registrado : 29/06/2012

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Noobezinho Dom Abr 11, 2021 8:22 am

    Creio que isso ajude:


    #If Win64 Then
         MsgBox "Aqui você colocar o winrar 64 Bits"
    #Else
         MsgBox "Aqui o winrar de 32 bits"
    #End If


    { }'s

    Balem


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...


    Ajude a ser ajudado:
    Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
    Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
    sem precisar procurar o mesmo.
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 8:47 am

    Olá a todos,

    Assis, como diz o nosso amigo JPaulo, "existe muitas formas de fazer Nestum" que significa que podemos obter o mesmo resultado de diversas formas.

    Eu dei a minha sugestão, e se o seu código da mensagem nr. 1 estiver a funcionar com uma linha de código resolve o problema, é necessário colocar no local certo (e colocar o modulo, é melhor dizer para nao ficar dúvidas).

    O colega Damasceno até avisou que a dúvida é recorrente, e concordo plenamente, podemos pedir ajudar, copiar e colar, mas também devemos olhar para o codigo e perceber o que ele está a fazer, como, quando e onde.
    Só desta forma é que você pode avancar para um novo patamar.

    A melhor forma é tentar relaxar e perceber o que o seu codigo está a fazer a última sugestão do colega Noob também é válida é só colocar no sitio correto (com as instruções que todos estamos a ver na mensagem n. 1).

    É só pensar "o meu problema está na parte do 32 ou 64, tenho que alterar ...hummmm, com um IF consigo detetar se é 32 ou 64... hummmm, deixa testar com calma).

    Bom almoço que vou fazer o mesmo.

    cheers
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 9:23 am

    Teixeira

    O meu código da menagem Nº 1 funciona perfeito no Office 32 e no 64, ambos no Win 64 e WinRar 64

    Coloquei o este seu código num modulo, mas não acerto com o local para e como chamar este seu código.

    Obrigado

    Public Function pathWinRar() As String
    'Álvaro Teixeira (ahteixeira) 2021
    'Obter caminho do WinRar, para verificar fazer algo assim:
    ' If Len(pathWinRar() & "") > 0 Then ...
    'Pode ser necessária referencia a "Microsoft Scripting Runtime"
    On Error Resume Next
    Dim WSHShell
    Set WSHShell = CreateObject("WScript.Shell")
    pathWinRar = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRar.EXE\")
    End Function




    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 3:27 pm

    Olá Assis,

    Se o código funciona porque abriu o tópico???
    "Na rotina abaixo que deteta qual o Office 32 ou 64 como, unir os dois código e ler o que necessita."

    Realmente podemos estar perante um erro de Português , ou melhor, falta de clareza (na minha opinião).

    Quanto à última questão, poderia dizer onde colocar, mas você já compreendeu o que a função faz?
    Já testou na janela imediata e ver o resultado?
    Pode ser que ajude onde colocar com o resultado (teste em máquinas com WinRar diferentes).

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 5:21 pm

    Olá Teixeira

    Não brinque com os meus cabelos brancos (a foto é antiga), que só hoje tiveram um aumento de 5%.

    Estou perto ?  

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t201


    .................................................................................
    *** Só sei que nada sei ***
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2816
    Registrado : 21/11/2016

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  DamascenoJr. Dom Abr 11, 2021 5:36 pm

    se a função pathwinrar já devolve o caminho com o arquivo executável (.exe), então não é necessário repetir winrar.exe em na expressão "winrar.exe a -r...


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 6:30 pm

    Damasceno

    Não funciona

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t204


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 6:41 pm

    Olá a todos,

    Assis, como podemos ver na imagem que partilhou (nr 14) devolve o caminho completo do winrar (se estiver instado, por isso na funcao coloquei o alerta para o IF).
    No seu codigo original tem:
    RarIt = shell(WinRarPath & "Winrar.exe a -r " & Dest & " " & SourceDir, vbHide)

    O correto sera alterar a parte indicada a vermelho,

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 7:04 pm

    Teixeira

    Assim ?  

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t206


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 7:10 pm

    Olá Assis,

    Exatamente, já deve funcionar, certo?
    Se sim , deve eliminar o codigo desnecessário.
    E volto a lembrar coloque o IF para o caso de ser um computador que nao tenha o WinRar instalado.

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 7:16 pm

    Olá Teixeira

    No Win 10 64, com Winrar 64, Office 2013 32 não funciona ...


    Só amanhã poderei testar no:

    No Win 10 64, com Winrar 64, Office 2016 64


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 7:30 pm

    Olá Assis,

    e funcionava antes da alteração???

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 7:40 pm

    Olá Teixeira


    Win 10 64, WinRar 64, Office 2013 32

    Atenção:
    Tirei as linhas que correspondem ao Office 2016 64  


    Funciona perfeito


    Código:
    Sub ComprimePastaComWinRar()

    Dim Msg As String
    On Error GoTo 1

    '*******************************************
      Dim FSO As Object
      Dim FromPath As String
      Dim ToPath As String
      Dim WinRarPath As String 'Localização do WinRar.exe
      Dim RarIt As String 'Instrução de linha de comando
      Dim SourceDir As String 'O diretório de origem
      Dim DestDir As String 'O diretório de destino
      Dim DestRarName As String
      Dim Dest As String 'Caminho de destino concatenado
      FromPath = Me!CaminhoEscolhido
      ToPath = Me!CaminhoEscolhido
      'inicia a criação da pasta
      Set fs = CreateObject("Scripting.FileSystemObject")
      'se a pasta existir, deleta
     
         If Right(FromPath, 1) = "\" Then
           FromPath = Left(FromPath, Len(FromPath) - 1)
      End If
      If Right(ToPath, 1) = "\" Then
          ToPath = Left(ToPath, Len(ToPath) - 1)
      End If
      Set FSO = CreateObject("scripting.filesystemobject")
      If FSO.FolderExists(FromPath) = False Then
          MsgBox FromPath & " Não Existe."
          Exit Sub
      End If
      'copia
      FSO.CopyFolder Source:=FromPath, Destination:=ToPath
     

        '*** Verifica se existe instalação do WinRar ***

    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    'Windows 10 64 - winrar 64 - Office 2013 32

         If Len(Dir("PROGRAMFILES") & "\Winrar\WinRar.EXE") & "" > 0 Then
       
          WinRarPath = "C:\Program Files\WinRar\"
      End If

     

      SourceDir = Me.CaminhoEscolhido

       'Verifica se a Pasta tem espaços nos nomes
      If InStr(1, SourceDir, " ", vbTextCompare) <> 0 Then SourceDir = Chr(34) & SourceDir & Chr(34)
     
      'Letra do Drive de destino
      DestDir = Me.CaminhoEscolhido
     

      If Dir(DestDir, vbDirectory) = "" Then MkDir DestDir
       DestRarName = "Backup.Rar"
       Dest = DestDir & "\" & DestRarName

      If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
     
             RarIt = shell(WinRarPath & "Winrar.exe a -r " & Dest & " " & SourceDir, vbHide)
     
       MsgBox "Backup Complecto Criado com Sucesso...", vbInformation, "" & DLookup("[Programa]", "Proprietario") & " " & DLookup("[Tipo]", "Proprietario")

          Me.Rótulo11.Caption = "A Compactar ..."
    volta:
              If ProgramaAtivo("WinRar") = True Then
                  Pause (5)
                  GoTo volta
              End If

    Call Comando25_Click


    Exit_1:
      DoCmd.Hourglass False
      DoCmd.Echo True
      Exit Sub

    1 A:
      DoCmd.Hourglass False
      DoCmd.Echo True
      Msg = "Erro # " & Str(Err.Number) & " gerado na " & Err.Source _
          & vbNewLine & vbNewLine & "Descrição: " & Err.Description _
          & vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
      MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", Err.HelpFile, Err.HelpContext
      Resume Exit_1

    End Sub


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 7:54 pm

    Ola,

    Onde tem:
    Código:
          RarIt = shell(WinRarPath & "Winrar.exe a -r " & Dest & " " & SourceDir, vbHide)

    altere por este

    Código:
          Dim strCmd
           strCmd = pathWinRar
           RarIt = Shell(strCmd & " a -r " & Dest & " " & SourceDir, vbHide)

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 8:04 pm

    Teixeira

    É igual não comprime.

    Obrigado

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t207


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 8:18 pm

    Assis,

    Retire o vbHide da instrucao para ver o erro (altere para normal)

    Abraco
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Dom Abr 11, 2021 8:33 pm

    Apareceu

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t208


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Dom Abr 11, 2021 8:49 pm

    Ola,

    colocou assim
    Código:
          Dim strCmd
           strCmd = pathWinRar
           RarIt = Shell(strCmd & " a -r " & Dest & " " & SourceDir, vbNormalFocus)
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Seg Abr 12, 2021 2:27 am

    Bom dia

    Com o oculto e também dá  mesmo erro do da imagem

    RarIt = shell(PathWinRar & " a -r " & Dest & " " & SourceDir, vbHide)

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t209


    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t210


    .................................................................................
    *** Só sei que nada sei ***
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2816
    Registrado : 21/11/2016

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  DamascenoJr. Seg Abr 12, 2021 8:25 am

    Marque um ponto de interrupção na linha RarIt... e pergunte a janela de verificação imediata a montagem final do seu comando, pois algo de errado ele tem

    ? PathWinRar & " a -r " & Dest & " " & SourceDir

    O código do tópico abaixo resolve
    https://www.maximoaccess.com/t38668-zipar-pastas-e-arquivos-com-o-winrar


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Seg Abr 12, 2021 8:39 am

    Damasceno

    Já estive a ver o seu código, mas ainda não percebi como o aplicar.

    Quanto a sua ultima mensagem sobre a janela imediata

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Sem_t211

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Seg Abr 12, 2021 9:04 am

    Damasceno

    Win 10 64, WinRar 64, e Office 2013 32 -----> Funciona com o seu código.  Laughing


    Vou almoçar e vou testar no Win 10 64, WinRar 64, e Office 2016 64 ----> E depois retorno


    .................................................................................
    *** Só sei que nada sei ***
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Seg Abr 12, 2021 10:41 am

    Damasceno

    Win 10 64, WinRar 64, e Office 2013 32 -----> Funciona com o seu código.  Laughing


    Win 10 64, WinRar 64, e Office 2016 64 ----> Funciona com o seu código.  Laughing


    Assim já não preciso mandar 1 programa para 8 postos com o Office 32 de trabalho, e outro para 4 postos de trabalho com o Office 2016 64.
    Obrigado Mestres
    Teixeira cheers
    Damasceno Laughing


    PS - Obrigado Franklin enviou um exemplo que vou estudar, pode servir para outras BDs


    Última edição por Assis em Seg Abr 12, 2021 10:42 am, editado 2 vez(es)


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Seg Abr 12, 2021 10:41 am

    Olá a todos,

    Assis, que bom que já vê uma luz.
    Quanto ao "ponto de interrupção", pode consultar neste tópico
    É necessário para ser perceber onde está o erro.

    Abraço
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7243
    Registrado : 15/03/2013

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  ahteixeira Seg Abr 12, 2021 10:44 am

    Olá Assis a última mensagem foi ao mesmo tempo Very Happy

    Que bom, mas fiquei sem perceber o que estava a provocar o erro, pode dar mais detalhes como ficou.
    Assim serve de estudo para outros membros.

    Abraço a todos
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4453
    Registrado : 06/11/2009

    [Resolvido]Comprimir com WinRar seja no Office 32 ou 64 Empty Re: [Resolvido]Comprimir com WinRar seja no Office 32 ou 64

    Mensagem  Assis Seg Abr 12, 2021 11:42 am

    Teixeira

    Foi na mensagem Nº 29, testei o exemplo do Damasceno e foi logo na primeira tentativa.

    O erro não sei porque não cheguei a elimina-lo.

    Quer que coloque aqui o código do comprimir ?

    Eu coloco e depois o Amigo apaga as mensagens que não tem interesse

    Obrigado.  

    ' ********* Código ********************

    Sub ComprimePastaComWinRar()

    Dim Msg As String
    On Error GoTo 1

       Dim FSO As Object
       Dim FromPath As String
       Dim ToPath As String
       Dim RarIt As String 'Instrução de linha de comando
       Dim SourceDir As String 'O diretório de origem
       Dim DestDir As String 'O diretório de destino
       Dim DestRarName As String
       Dim Dest As String 'Caminho de destino concatenado
       FromPath = Me!CaminhoEscolhido
       ToPath = Me!CaminhoEscolhido
       'inicia a criação da pasta
       Set fs = CreateObject("Scripting.FileSystemObject")
       'se a pasta existir, deleta
       
       If Right(FromPath, 1) = "\" Then
            FromPath = Left(FromPath, Len(FromPath) - 1)
       End If
       If Right(ToPath, 1) = "\" Then
           ToPath = Left(ToPath, Len(ToPath) - 1)
       End If
       Set FSO = CreateObject("scripting.filesystemobject")
       If FSO.FolderExists(FromPath) = False Then
           MsgBox FromPath & " Não Existe."
           Exit Sub
       End If
       'copia
       FSO.CopyFolder Source:=FromPath, Destination:=ToPath
       

       SourceDir = Me.CaminhoEscolhido

        'Verifica se a Pasta tem espaços nos nomes
       If InStr(1, SourceDir, " ", vbTextCompare) <> 0 Then SourceDir = Chr(34) & SourceDir & Chr(34)
       
       'Letra do Drive de destino
       DestDir = Me.CaminhoEscolhido
       
     
       If Dir(DestDir, vbDirectory) = "" Then MkDir DestDir
         DestRarName = "Backup.Rar"
            Dest = DestDir & "\" & DestRarName

       If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)
       
              RarIt = shell(fncDirWinRAR & " a -r " & Dest & " " & SourceDir, vbHide)
             
        MsgBox "Backup Complecto Criado com Sucesso...", vbInformation, "Aviso"

           Me.Rótulo11.Caption = "A Compactar ..."
         
    volta:
           If ProgramaAtivo("WinRar") = True Then
              Pause (5)
               GoTo volta
           End If

    'Call Comando25_Click


    Exit_1:
       DoCmd.Hourglass False
       DoCmd.Echo True
       Exit Sub

    1 A:
       DoCmd.Hourglass False
       DoCmd.Echo True
       Msg = "Erro # " & Str(Err.Number) & " gerado na " & Err.Source _
           & vbNewLine & vbNewLine & "Descrição: " & Err.Description _
           & vbNewLine & vbNewLine & "Por favor contate o Administrador de Sistema."
       MsgBox Msg, vbMsgBoxHelpButton + vbCritical, "Erro", Err.HelpFile, Err.HelpContext
       Resume Exit_1

    End Sub


    .................................................................................
    *** Só sei que nada sei ***

      Data/hora atual: Qua Jun 16, 2021 10:17 am