[Resolvido]Erro no exemplo de Backup

Como andas este amigo?

cumprimentos.

Olá, meu amigo Piloto.
Está de volta. Espero que com boa saúde e disposição renovada.
Andei fazendo testes e mais testes. Tive que dar uma parada pois tive um problema com meu HD onde está o windows XP e o office 2003.
Mas aproveitei a instalação nova do office 2003 e fui testar a forma com que o aplicativo instala o dropbox.
Quando formatei o pc notei que ele cria o usuário Administrador e o um usuário com o nome dado na instalação.
Com o aplicativo não consegui fazer o download do dropbox. Então fiz o download manual mesmo.
Quando tentei a instalação pelo aplicativo ele não encontrava o arquivo. Pensei que fosse pelo nome da versão que o aplicativo guarda
e troquei mas não deu.
Daí coloquei o aplicativo em C:// e fiz as alterações. Funcionou normal.Desinstalei tudo e criei uma subpasta com o nome Executáveis na pasta C://BackupRestaura e movi o arquivo de instalação do dropbox para ela.
Todo pc tem este caminho, independente do usuário.
Alterei, nos códigos as linhas de instalação do dropbox para o caminho completo.
E... tchan, tchan...funcionou. Instalou beleza.
Só não faz o download.
Agora também encontrei um erro ao tentar fazer restore com as opções marcadas para descompactar e o arquivo compactado não existir. Ele apaga o Be na pasta base e só depois dá a mensagem de que não localizou o arquivo.
Ainda não consegui resolver isto.
Depois coloco mais conclusões.
Com este lance de ter dado pau no HD estou movendo tudo para o novo.
Até mais.

ok...Bom trabalho

Bom, quebrei a cabeça por um bom tempo hoje tentando fazer ele desmarcar a opção "descompactar com o WinRar" caso o arquivo compactado
não exista mas não consegui.
Tentei também fazer com que ele não apague o arquivo BE se não encontrar o arquivo .rar mas também não consegui.
Vou pensar em mais soluções, alguma forma de impedir o usuário de marcar esta opção se o arquivo compactado não existir.
Obrigado.

O que está acontecendo... Escreva pouco porém com clareza...

O exemplo está funcionando ok?

O que deseja?

Que caso não tenha sido gerado o Backup ao clicar no botão restaurar nao apague o back-end?

Criei duas funções que conta os arquivos zip e accdb, tanto no dropbox como na pasta backup do sistema..

Se não encontrar arquivos não deixa efetuar a restauração assim evitando a deleção da base de dados.


Logo mais posto o procedimento.


Cumprimentos.

Para o botão Iniciar a restauração:

Código:

'------------------------------------------------------------------------------------------
' Procedure     : btIniciarBackup_Click
' Author        : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum         : Fórum Máximo Access -  http://maximoaccess.forumeiros.com/
' Date          : 24/09/2013
' Comentários   : Inicia o processo de Backup, aqui são verificadas as possíveis operações:
'                 > Restauração normal do DropBox
'                 > Restauração compatada do DropBox
'                 > Restaução normal na pasta backup do sistema
'                 > Restauração compactada na pasta backup do sistema
'                 > Restauração normal de arquivo selecionado manualmente
'                 > Restauração compactada de arquivo selecionado manualmente
'------------------------------------------------------------------------------------------
Private Sub btIniciarBackup_Click()
      Dim strOrigem As String, strDestino As String

      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
10    On Error GoTo TrataErro
      Dim NomeProcedimento As String
20        NomeProcedimento = "btIniciarBackup_Click"
          'Adiciona o nome do procedimento à função
30        PegaProcedimento (NomeProcedimento)
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      '---------------------------
      'Fecha o formulário de aviso
      '---------------------------
40    DoCmd.Close acForm, "frmAvisoDesconexao"
      '------------------------------------------------
      'Seto o timer para 0 para não atualizar a listbox
      '------------------------------------------------
50    Me.TimerInterval = 0
      '----------------------------------------------------------------------
      'Encerra o processo do WinRar caso exista algum resíduo no Task Manager
      '----------------------------------------------------------------------
60    Call MatarProcesso("WinRAR.exe")
      '-----------------------------------------------
      'Aplica no rótulo mensagem de início do processo
      '-----------------------------------------------
70    Me!Status.Caption = "Iniciando processo..."
      '-------------------------------------------------------------------------------------------------
      'Se foi clicado no botão "Selecionar Outro Backup" a variável booOutroBk será definida como true
      'Assim deve ir a restauração manual ou seja, selecionar manualmente o arquico de backup (rar/mdb)
      'para proseeguir com a restauração. Isto é necessário caso se restaure de um dispositivo removível
      '-------------------------------------------------------------------------------------------------
80    If booOutroBk = True Then
90        If StrExtensao = "Rar" Then
100           Me.RestauraManualZip
110       Else
120           Me.RestauraManual
130       End If
140   Else
          '--------------------------------
          'Restauração compatada do DropBox
          '--------------------------------
150       If Me.SelDrop = -1 And Me.selWinrar = -1 Then
            If ContaArqZip(Environ("HOMEDRIVE") & "\Dropbox\Backup\") = 0 Then
                MsgBox "Não há arquivos de Backup a serem restaurados!", vbInformation, "ATENÇÃO"
                Exit Sub
            End If
160           Me.RestauraBackupDropZip
          
           '-----------------------------
          'Restauração normal do DropBox
          '-----------------------------
170       ElseIf Me.SelDrop = -1 Then
            If ContaArqAccdb(Environ("HOMEDRIVE") & "\Dropbox\Backup\") = 0 Then
                MsgBox "Não há arquivos de Backup a serem restaurados!", vbInformation, "ATENÇÃO"
                Exit Sub
            End If
180           Me.RestauraBackupDrop
          
          '-------------------------------------------------
          'Restauração compactada na pasta backup do sistema
          '-------------------------------------------------
190       ElseIf Me.selWinrar = -1 Then
            If ContaArqZip(CurrentProject.path & "\Backup\") = 0 Then
                MsgBox "Não há arquivos de Backup a serem restaurados!", vbInformation, "ATENÇÃO"
                Exit Sub
            End If
200           Me.RestauraBackupPastaZip
          
          '-------------------------------------------
          'Restaução normal na pasta backup do sistema
          '-------------------------------------------
210       Else
            If ContaArqAccdb(CurrentProject.path & "\Backup\") = 0 Then
                MsgBox "Não há arquivos de Backup a serem restaurados!", vbInformation, "ATENÇÃO"
                Exit Sub
220           Me.RestauraBackupPasta
230       End If
240   End If
      End If
250   Exit Sub
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      'Tratamento de Erros
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
260       DoCmd.Hourglass False
270       DoCmd.Echo True
280   Exit Sub
TrataErro:
290       Select Case err.Number
              Case 0
                 'Não é um erro
300           Case Else
310             DoCmd.Hourglass False
320             DoCmd.Echo True
               'Chama a função global de tratamento de erros
330            GlobalErrHandler ("frmRestauraBackup")
340     End Select
End Sub



Observe onde chamo a função que verifica se existe arquivos de backup:

           If ContaArqAccdb(Environ("HOMEDRIVE") & "\Dropbox\Backup\") = 0 Then
               MsgBox "Não há arquivos de Backup a serem restaurados!", vbInformation, "ATENÇÃO"
               Exit Sub
           End If



As funções:

Código:

Function ContaArqZip(Diretorio As String) As Integer
Dim FSO, Pasta, Arquivo
Dim dtData As Date, DtDataMax As Date
'---------------
'Seta os objetos
'---------------
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Pasta = FSO.GetFolder(Diretorio)
For Each Arquivo In Pasta.Files
    '--------------------------------------------------------
    'Condição para pesquisar apenas arquivos em formato .rar
    '--------------------------------------------------------
    If Arquivo Like "*.rar" Then
        ContaArqZip = ContaArqZip + 1
    End If
Next
Set FSO = Nothing: Set Pasta = Nothing
End Function

Function ContaArqAccdb(Diretorio As String) As Integer
Dim FSO, Pasta, Arquivo
Dim dtData As Date, DtDataMax As Date
'---------------
'Seta os objetos
'---------------
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Pasta = FSO.GetFolder(Diretorio)
For Each Arquivo In Pasta.Files
    '---------------------------------------------------------
    'Condição para pesquisar apenas arquivos em formato .accdb
    '---------------------------------------------------------
    If Arquivo Like "*.accdb" Then
        ContaArqAccdb = ContaArqAccdb + 1
    End If
Next
Set FSO = Nothing: Set Pasta = Nothing
End Function


Veja que a função retorna a quantidade de arquivos na pasta... por isto ela está como integer...
Executa a contagem e incrementa caso exista arquivos na pasta

Olá meu amigo. Boa tarde.
Obrigado por mais e mais uma ajuda. Desculpe as demoras mas estou meio apertado de serviço. Fiquei fazendo cartuchos ontem até quase meia noite.
Vamos lá.
Eu uns testes aqui na tentativa de resolver, porque mesmo perguntando, continuo tentando.
Seu código, evidentemente é melhor e vou testar depois.
O que eu fiz foi colocar este código na sub btIniciarBackup_Click(), logo abaixo de DoCmd.Close acForm, "frmAvisoDesconexao":
Este:

If Me.txtArquivo Like "*.rar" Then
Me.selWinrar = -1
Else
Me.selWinrar = 0
End If

Nos primeiros testes funcionou mas ainda estava pensando em implementar avisos ao usuário e tal.
Desculpe a falta de clareza mas é a forma de tentar explicar e as vezes não dá para escrever pouco.
Estou tentando me colocar na posição de um usuário que não entende nada de access. Que vai simplesmente dar entrada
nos dados e desta forma estou tentando prever os erros.
Obrigado novamente.
Logo mais se der tempo testo.

Boa noite, meu amigo.
Estou tentando agora implementar os códigos.

Tenho que substituir algo na Sub btIniciarBackup_Click(), na linha 30 PegaProcedimento (NomeProcedimento)?
Pergunto porque tá dando erro de compilação sub ou function não definida.

Obrigado

Esta parte.. acima e a de baixo condiz com o tratamento de erros.. isto é do meu programa..

Estou carregando o exemplo de backup atualizado com esta função na sala de repositório.

Podes baixá-lo depois.

Cumprimentos.

Eis:

http://maximoaccess.forumeiros.com/t7554-backup-restauracao-no-disco-rigido-e-em-dispositivo-removivel-com-pesquisa-automatica-do-mesmo#119081

Cumprimentos.

Obrigado. Baixei e vou estudar.
Também estou quase conseguindo aqui. Pelo menos uma parte consegui.
De toda forma vou tentar com o meu pois se o que já fiz não interferir em outros restore pode ser que dê certo.
Assim aprendo mais comparando o seu e o meu.
Valeu

Olá, Piloto
Boa noite.

Consegui fazer funcionar do meu geito.
Fiz a seguinte alteração:

If Me.txtArquivo = "Arquivo não Encontrado" Then MsgBox "Arquivo não encontrado na pasta!" & Chr(13) & " Por favor, selecione outro.", vbCritical, "ATENÇÃO": GoTo ProximoEvento1

Me.txtArquivo = CurrentProject.Path & "\Backup\" & Me.txtArquivo

Em ProximoEvento1, coloquei
Me!cx1.Width = Escala * 4
Me!Status.Caption = "não encontrado..."
Pause (3)
DoCmd.Close acForm, "frmRestauraBackup"

Assim ele não apaga. Fiz o mesmo para o dropbox.
Até agora tá indo bem

Não testei ainda com o seu código porque as modificações que fiz estão deixando os dois com muitas diferenças um do outro. Como o caso acima, local de instalação do dropbox, etc.
Se permitir vou disponibilizar o que eu modifiquei, assim você dá uma olhada e me fala se está muito tosco ou não.
Grato

Desculpe incomodar novamente mas não estou encontrado o código ou função que faz o restore da pasta fotos.

O backup ele faz automaticamente zipado na própria pasta fotos.

Grato

Bom dia, meu amigo.

Não consegui ainda o restore da pasta fotos.
Vou ver se altero o backup da pasta fotos para a pasta de backup talvez consiga.
Obrigado.

Não cheguei a fazer o restore automático da pasta fotos...

Ainda o farei.. e penso em fazer por um botão separado.

Cumprimentos.

Ok, obrigado.
Pensei em estudar mais sobre o filecopy e copiar a pasta inteira para a pasta backup, mesmo sem compactar.
Vamos ver se consigo. Assim acredito que dá para copiar ela para o pendrive e para o dropbox porque até consigo
fazer para o drop mas fica tipo um arquivo não reconhecido.

Tenho implementa este Backup em todos os sistema e que faço.. tem funcionado perfeitamente.

A questão principal é:

Diferença de pastas do XP para o 7

A questão agora é você observar e tentar entender o código..
quando você entende o que o código faz.. é como se caisse a venda dos teus olhos.. e tudo fica claro e fácil de adaptar.
Automatizei o exemplo o máximo possível.. mas tem questões que ainda não consigo prever..

Por exemplo..

O Código que utilizo para checar a versão do windows retorna se é XP ou 7, porém o 7 tem na versão 32 bits (XP mascarado de 7) e 64 Bits..

Portanto se o código identificar o 7 mas for o de 32 bits.. poderá ocorrer erro, pois as pastas do 7 32 bits são semelhantes a do XP!

Bom estudo!

Tem muitas variáveis a observar sim.
Como eu disse no início este é para uso próprio e da forma que está já está de bom tamanho.
Mas sempre olho pela ótica de um usuário comum.
Acho que fica mais legal.
Vou continuar estudando mas antes vou tentar importar ele para o meu aplicativo que uso no trabalho.
Isto sim, é mais importante mas ainda não consegui. O máximo foi fazer o backup externamente ao meu aplicativo, fechando
ele e abrindo o BackupRestaura. Vamos ver, qualquer coisa grito por socorro, se não for abusar.

Ah, testei no access 2007 e deu certo, no 2010 não rola mesmo.

Obrigado.

Para o 2010 tem que colocar códigos necessários ao mesmo.. aqui no fórum tem exemplos...
Este código é colocado no cabeçalho do módulo..

É este código.. creio que deva ser colocado no cabeçalho de todos os módulos..


Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Private Declare PtrSafe Function GetDC Lib "User32" _
(ByVal hWnd As Long) As Long

Private Declare PtrSafe Function ReleaseDC Lib "User32" _
(ByVal hWnd As Long, ByVal hDC As Long) As Long

Ah tá, o PtrSafe.
Depois vou tentar mas por enquanto quero tentar os outros detalhes dele no office 2003/2007 porque troquei o hd que tem o 2010 pelo outro com o 2007 como você sugeriu.
Por enquanto estou dando uma estuda nos exemplos de código do JPaulo em
FSO
Assim, se funcionar direito no 2003 depois vou convertendo.
E ainda tenho que resolver o problema de não funcionar dentro do meu aplicativo.
Grato

Bom, meu amigo.
A questão deste exemplo no access 2003 vou dar por encerrado.
Ele faz tudo, backup e restore.
Mas quando importo para o meu banco de dados ou quando importo o meu banco de dados para dentro dele dá aquela mensagem:
Erro de compilação:
Tipo incorreto: era esperada matriz ou tipo definido pelo usuário
E marca a palavra "seq" no mdlCaminhoBE
Então depois de tentar por varios dias vou desistir e fazer uma adaptação no meu BD para abrir o do exemplo adaptado e em seguida
fazer o backup.
Assim terei tempo para converter o meu aplicativo para o 2007 e depois começar tudo com o backup no 2007.

Beleza..

Bom trabalho.

Ah, rapaz
Um detalhe que esqueci e que eu tinha comentado antes.

O aplicativo abre a página do dropbox e não faz o download. Até aí tudo bem, pode-se colocar uma mensagem ao
usuário informando que o download deve ser feito manualmente e instruí-lo a salvar em uma determinada pasta.
Agora quanto à instalação, o aplicativo faz mas as versões tem que ser iguais e estou notando que a cada vez que
a gente vai lá no dropbox é uma versão diferente.
Teria como colocar para instalar independente da versão? Tentei deixar apenas dropbox mas não deu. Pensei que
talvez alguma forma de usar curingas. Algo como dropbox *.* .exe
Obrigado

Não coloquei o exe do drop junto com o aplicativo?  não estou compreendendo...

Quando o sistema vai instalar o drop, caso no site do drop tenha uma versão mais atual ele não deixa instalar a versão que acompanha o sistema?

Não entendi.. de mais detalhes.

Cumprimentos.

É o seguinte.
Quando não tem o drop instalado o aplicativo faz a verificação e abre a página do drop.
Só que ele não baixa o arquivo de instalação. Até aí tudo bem.
A gente faz o download manual.
Só que na linha StrArquivo = CurrentProject.Path & "\Executaveis\Dropbox 1.4.3.exe" da função instaladrop tem esta versão
e no dropbox tem a versão 2.4.3.
Então quando o aplicativo vai instalar ele não consegue e dá a mensagem de arquivo não localizado pois a versão já está predefinida na linha de código acima. Se você editar a linha de código e colocar o 2.4.3 aí ele instala.
Creio que teria que ter algo mais ou menos assim:
StrArquivo = CurrentProject.Path & "\Executaveis\Dropbox *.*.exe"
Ou seja, instalar qualquer arquivo que comece com \Dropbox e que tenha a extensão .exe
Será que me fiz entender?

Entendi.. e está correto... Vou verificar assim que possível.

Cumprimentos.

Olá meu amigo Piloto
Como vai?

Já tentei aqui algumas coisas com relação à instalação do dropbox com versão diferente daquela indicada no código que mencionei
na minha mensagem anterior.
Por acaso você verificou algo neste sentido?
Grato

Refresque-me a memória..

Cumprimentos.

heheh, aí logo acima. Na mensagem 176 e seguintes.

É que você disse: Entendi.. e está correto... Vou verificar assim que possível.

Então só perguntei para ver se por acaso andou a verificar isto.

Você necessita que o código identifique o arquivo do Drop de qualquer verdsão baixada correto?

É por aqui:

Dim StrArquivo As String
Dim FSO, Diretorio As String, Pasta, Arquivo
Diretorio = CurrentProject.Path & "\Executaveis\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Pasta = FSO.GetFolder(Diretorio)
For Each Arquivo In Pasta.Files
StrArquivo = Diretorio & Arquivo.Name
Next
MsgBox StrArquivo
'Call Shell(StrArquivo)

Cumprimentos.

Tentei isto e não deu certo (sei que estou fazendo alguma coisa errada porque se posicionar o cursor em Arquivo o exe aparece mas em
Diretório dá como vazio.

Public Function InstalaDrop()
Dim FSO, Pasta, Arquivo
Dim StrArquivo As String
Dim Msg As String

If DCount("*", "tblSistemasDependentes", "SistemaDependente = 'DropBox' And Instalado = True") = 1 Then ChecaInstalacao:
Msg = MsgBox("É necessário além da conta no DropBox, a instalação" _
& vbNewLine & "do Módulo do DropBox no Sistema, deseja continuar?", vbYesNo + vbQuestionn, "INSTALAÇÃO DropBox")
Select Case Msg
Case vbYes
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Pasta = FSO.GetFolder("C:\Reciclagem\Executaveis")

If Len(Dir(Pasta, vbDirectory) & "") <> 0 Then
'StrArquivo = CurrentProject.Path & "\Executaveis\Dropbox 2.4.1.exe"

For Each Arquivo In Pasta.Files
StrArquivo = Diretorio & Arquivo.Name
Next
Call Shell(StrArquivo)
MsgBox "Será inciado o módulo de instalação do DropBox em seu computador" _
& vbNewLine & "Após a instalação reinicie o seu computador." _
& vbNewLine & "Será criado uma pasta em:" _
& vbNewLine & Environ("USERPROFILE") & "\Dropbox\" _
& vbNewLine & "Os arquivos de Backup serão gravados na sub Pasta >>> Public <<<" _
& vbNewLine & " " _
& vbNewLine & " " _
& vbNewLine & "O Sistema não emitirá mais esta mensagem." _
& vbNewLine & "Caso não tenha criado a conta" _
& vbNewLine & "poderá gerar erro ao efetuar o Backup no DropBox." _
& vbNewLine & "Se isto ocorrer vá no Menu ferramentas, >> Instalação DropBox <<" _
& vbNewLine & "E crie a conta, instalando em seguida o aplicativo do mesmo.", vbInformation, "INSTALAÇÃO DropBox"
'Atualiza a tabela para marcar como criada a conta do DropBox
CurrentDb.Execute "UPDATE tblSistemasDependentes set Instalado =1 WHERE SistemaDependente='DropBox'"

Else
End If

End Select
End Function


Grato

Na expressão que utiliza o GetFolder.. Você substituiu a variável diretório pelo caminho..

Observe que na minha eu carrego a variável com o caminho, utilizo a mesma no GetFolder e utilizo também para concatenar a mesma com o nome do arquivo.

Diretorio = CurrentProject.Path & "\Executaveis\"

Cumptimentos.

Beleza.
Funcionou legal mesmo.
Fiz no windows xp com office 2003. Agora vou fazer no windows 7 com office 2007.
Estou migrando tudo para o windows 7 e office 2007.
Mais de 100 gigas e ainda estou migrando mas organizando as pastas no
sistema do win7.
Obrigado meu amigo. Muito obrigado mesmo.
Quando eu terminar não me esquecerei do resolvido.

Beleza.