BACKUP ARQUIVO MDB... COMO FAZER?
Olá galera... Eu queria associar, numa rotina de gravação, um comando para copiar o arquivo mdb numa pasta em C:\.
Basicamente, a rotina de gravação é esta:
If MsgBox([Ô]Confirma gravar os dados digitados??[Ô], vbYesNo + vbQuestion, [Ô]Gravação de registro[Ô]) = vbNo Then
MsgBox [Ô]Gravação cancelada! ...[Ô], vbOKOnly + vbCritical, [Ô]Dados não registrados no sistema[Ô]
Unload Me
Else
AtualizaCampos
TbCadProdutos.Update
MsgBox [Ô]Registro gravado com sucesso...[Ô], vbOKOnly
[ô]Aqui entraria a rotina que copiaria o conteúdo da tabela atualizada para C:\Backup...
[ô]Em caso de perda ou de corrupção de dados, bastaria copiar manualmente o conteúdo de C:\Backup para a TbCadProdutos, na pasta <Arquivos de programas> ...
Agradeço qualquer idéia que eu pudesse adaptar e desenvolver (restauração, etc.).
Método Mais rápido:
Adicione um module e coloque o código:
Public Declare Function SHFileOperation Lib _
[Ô]shell32.dll[Ô] Alias [Ô]SHFileOperationA[Ô] _
(lpFileOp As Any) As Long
Public Declare Sub SHFreeNameMappings Lib _
[Ô]shell32.dll[Ô] (ByVal hNameMappings As Long)
Public Declare Sub CopyMemory Lib [Ô]KERNEL32[Ô] _
Alias [Ô]RtlMoveMemory[Ô] (hpvDest As Any, hpvSource _
As Any, ByVal cbCopy As Long)
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As FO_Functions
pFrom As String
pTo As String
fFlags As FOF_Flags
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String [ô]only used if FOF_SIMPLEPROGRESS
End Type
Public Enum FO_Functions
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum
Public Enum FOF_Flags
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10
FOF_WANTMAPPINGHANDLE = &H20
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80
FOF_SIMPLEPROGRESS = &H100
FOF_NOCONFIRMMKDIR = &H200
FOF_NOERRORUI = &H400
FOF_NOCOPYSECURITYATTRIBS = &H800
FOF_NORECURSION = &H1000
FOF_NO_CONNECTED_ELEMENTS = &H2000
FOF_WANTNUKEWARNING = &H4000
End Enum
Public Type SHNAMEMAPPING
pszOldPath As String
pszNewPath As String
cchOldPath As Long
cchNewPath As Long
End Type
Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte
lenFileop = LenB(lpFileOp)
ReDim foBuf(1 To lenFileop) [ô]the size of the structure.
Call CopyMemory(foBuf(1), lpFileOp, lenFileop)
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))
SHFileOP = result
End Function
Após a gravação COLOQUE, ou em um botão:
With fileop
.hwnd = 0
.wFunc = FO_COPY
.pFrom = txtOrigem & vbNullChar & vbNullChar
.pTo = txtDestino.Text & vbNullChar & vbNullChar
.lpszProgressTitle = [Ô]Aguarde, realizando copia...[Ô]
.fFlags = FOF_SIMPLEPROGRESS Or FOF_RENAMEONCOLLISION
End With
lret = SHFileOP(fileop)
If result <> 0 Then [ô]a operaçao falhou
MsgBox Err.LastDllError [ô]exibe o erro retornado pela API
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox [Ô]Operação falhou !!![Ô]
End If
End If
EM GENERAL DECLARATIONS:
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
Adicione um module e coloque o código:
Public Declare Function SHFileOperation Lib _
[Ô]shell32.dll[Ô] Alias [Ô]SHFileOperationA[Ô] _
(lpFileOp As Any) As Long
Public Declare Sub SHFreeNameMappings Lib _
[Ô]shell32.dll[Ô] (ByVal hNameMappings As Long)
Public Declare Sub CopyMemory Lib [Ô]KERNEL32[Ô] _
Alias [Ô]RtlMoveMemory[Ô] (hpvDest As Any, hpvSource _
As Any, ByVal cbCopy As Long)
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As FO_Functions
pFrom As String
pTo As String
fFlags As FOF_Flags
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String [ô]only used if FOF_SIMPLEPROGRESS
End Type
Public Enum FO_Functions
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum
Public Enum FOF_Flags
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10
FOF_WANTMAPPINGHANDLE = &H20
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80
FOF_SIMPLEPROGRESS = &H100
FOF_NOCONFIRMMKDIR = &H200
FOF_NOERRORUI = &H400
FOF_NOCOPYSECURITYATTRIBS = &H800
FOF_NORECURSION = &H1000
FOF_NO_CONNECTED_ELEMENTS = &H2000
FOF_WANTNUKEWARNING = &H4000
End Enum
Public Type SHNAMEMAPPING
pszOldPath As String
pszNewPath As String
cchOldPath As Long
cchNewPath As Long
End Type
Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte
lenFileop = LenB(lpFileOp)
ReDim foBuf(1 To lenFileop) [ô]the size of the structure.
Call CopyMemory(foBuf(1), lpFileOp, lenFileop)
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))
SHFileOP = result
End Function
Após a gravação COLOQUE, ou em um botão:
With fileop
.hwnd = 0
.wFunc = FO_COPY
.pFrom = txtOrigem & vbNullChar & vbNullChar
.pTo = txtDestino.Text & vbNullChar & vbNullChar
.lpszProgressTitle = [Ô]Aguarde, realizando copia...[Ô]
.fFlags = FOF_SIMPLEPROGRESS Or FOF_RENAMEONCOLLISION
End With
lret = SHFileOP(fileop)
If result <> 0 Then [ô]a operaçao falhou
MsgBox Err.LastDllError [ô]exibe o erro retornado pela API
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox [Ô]Operação falhou !!![Ô]
End If
End If
EM GENERAL DECLARATIONS:
Dim lret As Long
Dim fileop As SHFILEOPSTRUCT
Esse código abaixo faz um backup e ainda compacta o banco:
Private Sub CmdGera_Click()
Dim vData As String
Dim vSigla As String
On Error GoTo TrataErro
vData = Format(Date, [Ô]dd-mm-yyyy[Ô])
vSigla = [Ô]SYS[Ô]
[ô] COMPACTA E REPARA O BANCO
Screen.MousePointer = vbHourglass
[ô]DBEngine.RepairDatabase App.Path & [Ô]\banco.mdb[Ô]
If DIR(TxtLocal.Text & [Ô]banco_[Ô] & vData & [Ô]-[Ô] & vSigla & [Ô].mdb[Ô]) <> [Ô][Ô] Then
Kill TxtLocal.Text & [Ô]banco_[Ô] & vData & [Ô]-[Ô] & vSigla & [Ô].mdb[Ô] [ô]verifica se o arquivo existe, e deleta
End If
dbBanco.Close: Set dbBanco = Nothing
DBEngine.CompactDatabase App.Path & [Ô]\banco.mdb[Ô], TxtLocal.Text & [Ô]banco_[Ô] & vData & [Ô]-[Ô] & vSigla & [Ô].mdb[Ô], dbLangGeneral & [Ô]; pwd=[Ô], , [Ô]; pwd=[Ô] [ô]cria o arquivo compactado e mantem senha
dbBanco.Open [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=[Ô] & App.Path & [Ô]\banco.mdb[Ô] & [Ô]; User Id=;Password=;[Ô]
Screen.MousePointer = vbDefault
MsgBox [Ô]Backup realizado com sucesso![Ô], vbInformation, [Ô]Aviso[Ô]
Barra.Value = 0
Exit Sub
TrataErro:
Screen.MousePointer = vbDefault
MsgBox [Ô]Não foi possÃvel gerar o Backup![Ô], vbCritical, [Ô]Aviso[Ô]
Exit Sub
End Sub
Private Sub CmdGera_Click()
Dim vData As String
Dim vSigla As String
On Error GoTo TrataErro
vData = Format(Date, [Ô]dd-mm-yyyy[Ô])
vSigla = [Ô]SYS[Ô]
[ô] COMPACTA E REPARA O BANCO
Screen.MousePointer = vbHourglass
[ô]DBEngine.RepairDatabase App.Path & [Ô]\banco.mdb[Ô]
If DIR(TxtLocal.Text & [Ô]banco_[Ô] & vData & [Ô]-[Ô] & vSigla & [Ô].mdb[Ô]) <> [Ô][Ô] Then
Kill TxtLocal.Text & [Ô]banco_[Ô] & vData & [Ô]-[Ô] & vSigla & [Ô].mdb[Ô] [ô]verifica se o arquivo existe, e deleta
End If
dbBanco.Close: Set dbBanco = Nothing
DBEngine.CompactDatabase App.Path & [Ô]\banco.mdb[Ô], TxtLocal.Text & [Ô]banco_[Ô] & vData & [Ô]-[Ô] & vSigla & [Ô].mdb[Ô], dbLangGeneral & [Ô]; pwd=[Ô], , [Ô]; pwd=[Ô] [ô]cria o arquivo compactado e mantem senha
dbBanco.Open [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=[Ô] & App.Path & [Ô]\banco.mdb[Ô] & [Ô]; User Id=;Password=;[Ô]
Screen.MousePointer = vbDefault
MsgBox [Ô]Backup realizado com sucesso![Ô], vbInformation, [Ô]Aviso[Ô]
Barra.Value = 0
Exit Sub
TrataErro:
Screen.MousePointer = vbDefault
MsgBox [Ô]Não foi possÃvel gerar o Backup![Ô], vbCritical, [Ô]Aviso[Ô]
Exit Sub
End Sub
Valeu, galera.... Vou estudar as rotinas para adaptar no meu project.
Abraços...
Tópico encerrado , respostas não são mais permitidas