[Resolvido]Compactar pasta do BD com Winrar

Boa noite amigos

A minha duvida é o seguinte:
Nas linhas a vermelho uma é para a localização do Win 8 64, outra para o Windows 7 32

Como por este código a detetar qual o Windows do sistema e ir para a linha correta da localização do Winrar.

Sub ComprimePastaComWinRar()
'By Piloto
   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
   'inicio da copia
   FSO.CopyFolder Source:=FromPath, Destination:=ToPath

        '*** Verifica se existe instalação do WinRar ***
    'WinRarPath = "C:\Program Files (x86)\WinRar\"  'Para Windows 8  64
     WinRarPath = "C:\Program Files\WinRar\"          'Para Windows 7  32

   If Dir(WinRarPath, vbDirectory) = "" Then
       MsgBox "O WinRar não está instaldo nesse diretorio." _
       & Chr$(13) & "Impossivel comprimir."
       Exit Sub
   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 Formato WinRar criado com sucesso...", vbInformation, "Aviso"
   DoCmd.Quit
End Sub

Obrigado

Bom Dia Assis,
Tem aqui a solução: http://www.usandoaccess.com.br/tutoriais/configurar-api-access-de-64-e-32-bits-ptrsafe.asp?id=1#inicio
Um excelente artigo do Mestre Avelino.
Abraço

Teixeira

As ditas duas linhas a vermelho alterei para:

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

E funciona nos 2 sistemas

Obrigado

Olá, obrigado pelo retorno
Também poderia colocar assim no seu código:

Código:

    If Len(Dir(Environ("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "") > 0 Then
        WinRarPath = "C:\Program Files\WinRar\"
    ElseIf Len(Dir(Environ("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "") > 0 Then
        WinRarPath = "C:\Program Files (x86)\WinRar\"
    Else
        MsgBox "O WinRar não está instaldo nesse diretorio." _
        & Chr$(13) & "Impossivel comprimir."
        Exit Sub
    End If

e retirava o if seguinte.
Abraço

Boas Teixeira

Quando eu disse que funcionava nos dois sistemas, era em no Windows 7 32, com Office 2010  32, e no RunTime

Porque;

Com Windows 8.1 - 64 , com Office 2007  - 32 não funciona

 If Len(Dir(Environ("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "") > 0 Then ' Esta aqui funciona em Win 7 - 32 com Office 2010 - 32
       WinRarPath = "C:\Program Files\WinRar\"
   ElseIf Len(Dir(Environ("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "") > 0 Then
       WinRarPath = "C:\Program Files (x86)\WinRar\"
   Else
       MsgBox "O WinRar não está instaldo nesse diretorio." _
        & Chr$(13) & "Impossivel comprimir."
       Exit Sub
   End If

Obrigado

Up

Olá Assis, o tópico está dado como resolvido???
No entanto uma vez que em Windows 8.1 em 64 não dá, diga-me:
1) Qual a pasta em que está instalado o Winrar
2) Qual o nome do ficheiro executavel do winrar e se é 32 ou 64.
Abraço

Boa noite...apenas um simples pitaco....

1- instalar o winrar para 64bits. ( de forma alguma utilizar o de 32 bits para esse fim )
2- o mesmo ficará instalado na pasta c:\Arquivos de programa ( diferentemente do 32 bits que fica em c:\Arquivos de programas (86)) .

3- mudar para esse:

If Len(Dir(Environ("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "") > 0 Then
WinRarPath = "C:\Program Files\WinRar\"
ElseIf Len(Dir(Environ("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "") > 0 Then
WinRarPath = "C:\Program Files \WinRar\"
Else
MsgBox "O WinRar não está instaldo nesse diretorio." _
& Chr$(13) & "Impossivel comprimir."
Exit Sub
End If

Boa tarde Amigos

Esta funciona em windows 7 - 32 Bits e office 2010 - 32 Bits
 
    If Len(Dir(Environ("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "") > 0 Then
    WinRarPath = "C:\Program Files\WinRar\"
    MsgBox "O WinRar não está instaldo nesse diretorio." _
    & Chr$(13) & "Impossivel comprimir."
    Exit Sub
    End If



Esta funciona em windows 8.1 - 64 Bits e office 2007 - 32 Bits

   If Len(Dir(Environ("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "") > 0 Then
       WinRarPath = "C:\Program Files (x86)\WinRar\"
   Else
       MsgBox "O WinRar não está instaldo nesse diretorio." _
        & Chr$(13) & "Impossivel comprimir."
       Exit Sub
   End If


Se juntar as duas assim não funciona,

Porque ?

If Len(Dir(Environ("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "") > 0 Then
WinRarPath = "C:\Program Files\WinRar\"
ElseIf Len(Dir(Environ("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "") > 0 Then
WinRarPath = "C:\Program Files (x86)\WinRar\"
Else
MsgBox "O WinRar não está instaldo nesse diretorio." _
& Chr$(13) & "Impossivel comprimir."
Exit Sub
End If

Olá Assis, teste nas diversas maquinas e sistemas operativos e verifique o resultado

Teixeira

O resultado é igual ..

Olá, então ja compreende porque não funciona.
Como maioritariamente o sistema é instalado na unidade c: e estou convencido que aplicação não é para rolar em xp.
Coloque o caminho directamente na verificação (dir()).
Não use o environ.
Abç.

Teixeira
Assim funciona no no windows 8.1 - 64 Bits e office 2007 - 32 Bits, mas não no windows 7 - 32 Bits e office 2010 - 32 Bits

If Len(Dir("PROGRAMFILES(x86)") & "\Winrar\WinRAR.EXE") & "" > 0 Then 'windows 8.1 - 64 Bits e office 2007 - 32 Bits
      WinRarPath = "C:\Program Files (x86)\WinRar\"
  ElseIf Len(Dir("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "" > 0 Then 'windows 7 - 32 Bits e office 2010 - 32 Bits
    WinRarPath = "C:\Program Files\WinRar\"
  Else
      MsgBox "O WinRar não está instaldo nesse diretorio." _
       & Chr$(13) & "Impossivel comprimir."
      Exit Sub
  End If

Se inverter os If funciona no Win 7 e não no Win 8

Conclusão:

A parte (  ElseIf Len(Dir("PROGRAMFILES") & "\Winrar\WinRAR.EXE") & "" > 0 Then ) neste caso é ignorada ?

Obrigado

Olá Assis,
Baixe de novo exemplo mensagem nº 10 e teste nas diversas maquinas e sistemas operativos.
Abraço

Viva Teixeira



Obrigado

Obrigado pelo retorno.
Abraço