terça-feira, 22 de agosto de 2017
assinantes
   Assinatura Ativo Access


Não Assinantes
ConteÚdo
DOWNLOADS
Interação
dicas aleatórias
Dica #62
Coquetel de dicas
Publicado: 26/04/2007

Artigos

BackUp da base de dados: nunca é demais

Se você não está disposto da fazer backup da base de dados do seu sistema, pense bem: é melhor não ter sistema! Veja nesse artigo como é fácil ter uma estrutura sólida de backup duplo com reserva de cópias de uma semana.

Por: Roberto Amaral Fernandes  (amaral@ativoaccess.com.br)
Publicado: 24/02/2011  Visitas: 4538
Dificuldade: Intermediário

Indicação de Artigo  Imprimir

Artigo para Access 2003
Pré-requisitos: Conhecimento intermediário de VBA


Figura 1 – Interface para o backup.

1. Por que copiar do PenDrive para o microcomputador de negócios?
Muitos empresários tem o hábito de analisar seus relatórios e dados de negócios em seu computador pessoal (notebook), muitas vezes os dados são alterados e no expediente seguinte querem devolver a base de dados para o microcomputador de negócios.

Sabendo disso o desenvolvedor providencia a separação da base de dados do sistema em dois arquivos: NomeDoSistema_fe.mde (fe = front end) NomeDoSistema_be.mdb (be = back end)e permite que uma cópia do seu sistema seja instalado no computador pessoal do cliente, acessando a base de dados no pendrive. Dessa maneira, o cliente após fazer backup pode analisar seus negócios na tranquilidade da sua casa, fazer atualizações e devolver a base de dados no expediente seguinte.

Com isso fica possível implantar o backup da forma como estamos propondo.

A maior parte das dúvidas estão explicadas na tela Leiame da interface:


Figura 2 – Clique no comando Leiame.

Por que atualizar a letra do drive do PenDrive?


Figura 3 – Diálogo para obter a letra do drive do pendrive


Quando o pendrive é “espetado” no computador o Windows imediatamente já informa a letra do drive escolhido. O problema é que essa letra pode variar de pendrive para pendrive. Por isso providenciei uma forma de informar a letra do drive.

2 – Estrutura de pastas do pendrive:

Para usar o procedimento que estou propondo aqui é preciso preparar a estrutura de pastas do pendrive da forma como está na figura:


Figura 4 – Pastas do pendrive


Você ainda pode desenvolver a estrutura acima para ter backup quinzenal, mensal, trimestral, semestral ou mesmo anual, tudo de acordo com a necessidade do usuário.
Para uso corriqueiro o backup semanal será suficiente. Você sempre terá o arquivo da última segunda-feira, da terça e assim por diante, e também do dia imediatamente anterior. Tudo isso possível graças a grande capacidade de armazenamento do pendrive.




Figura 5 – Caixa de diálogo facilitadora para obter o “path” da base de dados. Coloquei uma caixa para cada opção.


Confirmação:

Ao clicar nos comandos “Copiar do ...” a interface sempre confirmará.


Figura 6 – Tem certeza?


No primeiro backup não haverá perguntas de “updates”. Mas no backup seguinte, já havendo arquivo é preciso confirmar o update. Haverão duas confirmações, lembrando que são dois backups para cada clique.



3 – Fazendo backup:


Figura 7 – Copiar e substituir

4. Entendeu tudo? Vamos aos códigos

Códigos nos comandos “Atualizar letra...” e “Leiame”


Private Sub AtualizaLetra_Click()
On Error GoTo Err_AtualizaLetra_Click
Dim stDocName As String
DoCmd.SetWarnings False
stDocName = "qryAtualizaPenDrive"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Me.Drive = DLookup("[Drive]", "tblPenDrive")
Form_Open (0)
DoCmd.SetWarnings True
Exit_AtualizaLetra_Click:
Exit Sub
Err_AtualizaLetra_Click:
MsgBox Err.Description
Resume Exit_AtualizaLetra_Click
End Sub

Private Sub Leiame_Click()
On Error GoTo Err_Leiame_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frmCopy_Explica"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Leiame_Click:
Exit Sub

Err_Leiame_Click:
MsgBox Err.Description
Resume Exit_Leiame_Click

End Sub


Código ao abrir a interface e obter a letra do pendrive já existente, dia da semana, fazer backup e outros:


Private Sub Form_Open(Cancel As Integer)
DoCmd.Maximize
Me.Drive = DLookup("[Drive]", "tblPenDrive")
If Not IsNull(Me.Drive) Then
Me.strOrigem = "C:\SisBackUp\SisBackUp_be.mdb"
Me.strDestino = Me.Drive & "\SisBackUp\SisBackUp_be.mdb"
Me.strOrigemPM = Me.Drive & "\SisBackUp\SisBackUp_be.mdb"
Me.strDestinoPM = "C:\SisBackUp\SisBackUp_be.mdb"

Dim DiaDaSemana As String
Select Case Weekday(Date)
Case 1
DiaDaSemana = "Domingo"
Case 2
DiaDaSemana = "Segunda-Feira"
Case 3
DiaDaSemana = "Terça-Feira"
Case 4
DiaDaSemana = "Quarta-Feira"
Case 5
DiaDaSemana = "Quinta-Feira"
Case 6
DiaDaSemana = "Sexta-Feira"
Case 7
DiaDaSemana = "Sábado"
End Select
Me.DiaDaSemanaMP = Me.Drive & "\" & DiaDaSemana & "\SisBackUp_be.mdb"
Me.Comando0.SetFocus
Else
MsgBox "Informe a letra correspondente ao drive do seu pendrive seguida de :", vbInformation, "SisBackup"
Me.Drive.SetFocus
End If
End Sub


Códigos das caixas de diálogo:

Private Sub Comando0_Click()

fMakeBackup (Me.strOrigem), (Me.strDestino)
fMakeBackup (Me.strOrigem), (Me.DiaDaSemanaMP)

End Sub

Private Sub Comando10_Click()
fMakeBackup (Me.strOrigemPM), (Me.strDestinoPM)
End Sub

Private Sub Comando15_Click()

On Error GoTo TrataErro:

Dim valret As String
valret = GetOpenFile(, "Selecione o arquivo SisBackUp_be a ser copiado", "*.*", "*.*", Me.hWnd)
If valret <> "" And Not IsNull(valret) Then
Me.strOrigemPM = valret
End If
TrataErro:
If Err.Number > 0 Then
Exit Sub
End If
End Sub

Private Sub Comando16_Click()

On Error GoTo TrataErro:

Dim valret As String
valret = GetOpenFile(, "Selecione o arquivo SisBackUp_be a ser copiado", "*.*", "*.*", Me.hWnd)
If valret <> "" And Not IsNull(valret) Then
Me.strDestinoPM = valret
End If
TrataErro:
If Err.Number > 0 Then
Exit Sub
End If
End Sub

Private Sub Comando5_Click()

On Error GoTo TrataErro:

Dim valret As String
valret = GetOpenFile(, "Selecione o arquivo SisBackUp_be a ser copiado", "*.*", "*.*", Me.hWnd)
If valret <> "" And Not IsNull(valret) Then
Me.strDestino = valret
End If
TrataErro:
If Err.Number > 0 Then
Exit Sub
End If
End Sub



Figura 8: Lógico: você precisará de alguns módulos

Códigos cedidos pelo mago Dev Ashish:


Como copiar arquivos com a animação de documentos voando de uma pasta para outra? 'A animação faz parte
'da função SHFileOperation de Shell32.dll, a ser executada com certos flags definidos como constantes num módulo.
'A função da API precisa de uma estrutura de dado chamada SHFILEOPSTRUCT:
'Veja um exemplo no site The Access Web, artigo "Copy a database":
'http://www.mvps.org/access/api/api0026.htm
'Here 's an API based method to make a backup of the current database.
'Please note that this function does not work on Exclusively opened database.
'The backup is created with a "Copy of (?)" prefix to the database name in the same directory as the original database itself.

'********** Code Start *************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' Code Courtesy of Dev Ashish
'*********************************************************************
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

Private Const FOF_MULTIDESTFILES As Long = &H1
Private Const FOF_CONFIRMMOUSE As Long = &H2
Private Const FOF_SILENT As Long = &H4
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_WANTMAPPINGHANDLE As Long = &H20
Private Const FOF_CREATEPROGRESSDLG As Long = &H0
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_FILESONLY As Long = &H80
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_NOCONFIRMMKDIR As Long = &H200

Private Declare Function apiSHFileOperation Lib "C:\Windows\System32\Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Function fMakeBackup(wOrigem, wDestino) As Boolean

Dim strMsg As String
Dim tshFileOp As SHFILEOPSTRUCT
Dim lngRet As Variant
Dim strSaveFile As String
Dim lngFlags As Long
Const cERR_USER_CANCEL = vbObjectError + 1
Const cERR_DB_EXCLUSIVE = vbObjectError + 2
On Local Error GoTo fMakeBackup_Err

If fDBExclusive = True Then Err.Raise cERR_DB_EXCLUSIVE

strMsg = "Você tem certeza que quer fazer a cópia?"

If MsgBox(strMsg, vbQuestion + vbYesNo, "Confirme !") = vbNo Then Err.Raise cERR_USER_CANCEL

lngFlags = FOF_SIMPLEPROGRESS Or _
FOF_FILESONLY 'Or _
'FOF_RENAMEONCOLLISION

strSaveFile = CurrentDb.Name

With tshFileOp
.wFunc = FO_COPY
.hWnd = hWndAccessApp
.pFrom = wOrigem & vbNullChar
.pTo = wDestino & vbNullChar
.fFlags = lngFlags
End With
lngRet = apiSHFileOperation(tshFileOp)
fMakeBackup = (lngRet = 0)

fMakeBackup_End:
Exit Function
fMakeBackup_Err:
fMakeBackup = False
Select Case Err.Number
Case cERR_USER_CANCEL:
'do nothing
Case cERR_DB_EXCLUSIVE:
MsgBox "The current database " & vbCrLf & CurrentDb.Name & vbCrLf & _
vbCrLf & "is opened exclusively. Please reopen in shared mode" & _
" and try again.", vbCritical + vbOKOnly, "Database copy failed"
Case Else:
strMsg = "Error Information..." & vbCrLf & vbCrLf
strMsg = strMsg & "Function: fMakeBackup" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg, vbInformation, "fMakeBackup"
End Select
Resume fMakeBackup_End
End Function

Function fCurrentDBDir() As String
'code courtesy of Terry Kreft
Dim strDBPath As String
Dim strDBFile As String
strDBPath = CurrentDb.Name
strDBFile = strDBPath
fCurrentDBDir = Left(strDBPath, InStr(strDBFile, strDBPath) - 1)
End Function

Function PegaPasta(ArquivoClicado As String) As String
'cortesia de Amaral 26/05/2003

Dim i As Integer

For i = 1 To Len(ArquivoClicado)

If Mid(ArquivoClicado, Len(ArquivoClicado) - i, 1) = "\" Then
PegaPasta = Left(ArquivoClicado, Len(ArquivoClicado) - i)
Exit For
End If

Next i

End Function

Function fDBExclusive() As Integer
Dim db As Database
Dim hFile As Integer
hFile = FreeFile
Set db = CurrentDb
On Error Resume Next
Open db.Name For Binary Access Read Write Shared As hFile
Select Case Err
Case 0
fDBExclusive = False
Case 70
fDBExclusive = True
Case Else
fDBExclusive = Err
End Select
Close hFile
On Error GoTo 0
End Function
'************* Code End ***************


Mais códigos desta vez cedidos pelo também mago Ken Getz

'This code was originally written by Ken Getz.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
' Code courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996

Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function GetOpenFile(Optional varDirectory As Variant, _
Optional varTitleForDialog As Variant, _
Optional strDescription As String, Optional varItem, Optional varHwnd As Long) As Variant
'Incluídas as variáveis strDescription, varItem e varHwnd por JR.
' Here's an example that gets an Access database name.
Dim lngFlags As Long, strFilter As String
Dim varFileName As Variant
' Especifica que o arquivo escolhido já deve existir,
' não muda diretórios ao terminar. Também não mostra
' a caixa read-only.
lngFlags = ahtOFN_FILEMUSTEXIST Or _
ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If

' Define the filter string and allocate space in the "c"
' string Duplicate this line with changes as necessary for
' more file templates.
strFilter = ahtAddFilterItem(strFilter, strDescription, varItem)
' Now actually call to get the file name.
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog, _
hWnd:=varHwnd)

If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
GetOpenFile = varFileName
End Function


Function ahtCommonFileOpenSave( _
Optional ByRef Flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal FileName As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hWnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant

' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = ""
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = ""
If IsMissing(FileName) Then FileName = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(hWnd) Then hWnd = Application.hWndAccessApp
If IsMissing(OpenFile) Then OpenFile = True
' Allocate string space for the returned strings.
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hWnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
' Didn't think most people would want to deal with
' these options.
.hInstance = 0
.strCustomFilter = ""
.nMaxCustFilter = 0
.lpfnHook = 0
'New for NT 4.0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With

' This will pass the desired data structure to the
' Windows API, which will in turn it uses to display
' the Open/Save As Dialog.
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If

' The function call filled in the strFileTitle member
' of the structure. You'll have to write special code
' to retrieve that if you're interested.
If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = "" 'alterado por JR.
End If
End Function


Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.

If IsMissing(varItem) Then varItem = "*.*"
ahtAddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function


Conclusão

Que o backup é imprescindível todos nós já sabemos, mas quanto mais facilitado para o usuário melhor. Isto pode ser a diferença entre usar ou não usar um bom sistema.

Exemplo: Backup do AtivoAccess – descompacte na pasta C:\SisBackUp.

Links relacionados:
http://

Artigos relacionados:
  Nenhum artigo relacionado

 

Assine AtivoAccess
     CD Ativo Access = R$ 44,70

 

 

   Copyright © Ativo Access 2003 - 2017- Todos os direitos reservados   Política de Privacidade | Fale conosco