Alvaro Teixeira 17/10/2015, 00:29
Olá Assis, fiz a tradução, para melhor compreensão.
Repare na linha que postou, tem que colocar o nome da tabela ligada, veja no meu exemplo é a tabela "tbl_clientes"
strSource = Split(Split(CurrentDb.TableDefs("tbl_clientes").Connect, "Database=")(1), ";")(0)Quanto à questão da password, veja como deve fazer:
DBEngine.CompactDatabase strDestination & ".cpk", strDestination, ";pwd=1234", , ";pwd=1234" - Código:
On Error GoTo Err_Handler
Dim oFSO As Object
Dim strDestination As String
Dim strSource As String
Dim path As String, name As String
path = CurrentProject.path
name = CurrentProject.name
Const conPATH_FILE_ACCESS_ERROR = 75
'Para obter o caminho da fonte da tabela do back end (ligada)
strSource = Split(Split(CurrentDb.TableDefs("tbl_clientes").Connect, "Database=")(1), ";")(0)
'Definir o destino do backup
strDestination = path & "\" & Left(name, Len(name) - 4) & "_backup" & "_" & _
Year(Now) & "_" & Month(Now) & "_" & Day(Now) & ".mdb"
'Para apagar outro backup do mesmo dia, caso exista
If Dir(strDestination) <> "" Then
Kill strDestination
End If
'aqui cria um backup em caminho de destino
If Dir(strDestination) = "" Then
'Libertar o cache do banco de dados atual
DBEngine.Idle
'Criar script que irá efectuar o backup do db
Set oFSO = CreateObject("Scripting.FileSystemObject")
oFSO.CopyFile strSource, strDestination
Set oFSO = Nothing
'compactar o novo ficheiro, ...
Name strDestination As strDestination & ".cpk"
DBEngine.CompactDatabase strDestination & ".cpk", strDestination, ";pwd=1234", , ";pwd=1234"
Kill strDestination & ".cpk"
'mensagem de aviso
MsgBox "Ficheiro de Backup '" & strDestination & "' foi criado com sucesso!", vbInformation, "Backup Completo"
End If
Exit_Button_Backup:
Exit Sub
Err_Handler:
If Err.Number = conPATH_FILE_ACCESS_ERROR Then
MsgBox "The following Path, " & strDestination & ", already exists or there was an Error " & _
"accessing it!", vbExclamation, "Path/File Access Error"
Else
MsgBox Err.Description, vbExclamation, "Error Creating " & strDestination
End If
Resume Exit_Button_Backup
Segue o meu teste abaixo.
Nota, vou dividir o tópico para ficar mais coerente.
Cabe a todos ter cuidado ao postar, de forma a se manter o fórum "arrumado".
Abraço
- Anexos
- AssisTesteBackup.zip
- Você não tem permissão para fazer download dos arquivos anexados.
- (30 Kb) Baixado 29 vez(es)
Última edição por ahteixeira em 29/1/2016, 14:58, editado 2 vez(es)