怎样对access数据库的备份？

[yiyongxiang]

处了使用filecopy和copyfile以外

[wingchi]

up

[strongfisher]

Private Sub m_backup_Click() '备份数据库

On Error Resume Next

Dim SHFileOp As SHFILEOPSTRUCT

SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = App.Path & "\msDATAformobile.mdb"
SHFileOp.pTo = App.Path & "\back\msDATAformobile.mdb"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR
Call SHFileOperation(SHFileOp)
MsgBox "备份已完成!"
Exit Sub

ErrHandler:
Me.MousePointer = 0

End Sub

[strongfisher]

Public Const FO_MOVE = &H1
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_NOCONFIRMMKDIR = &H200
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_SILENT = &H4
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

[yiyongxiang]

还有没有？

[wxy001]

Private WithEvents objBlockedIO As MyCopyClass


Private Sub cmdCancel_Click()
objBlockedIO.Cancel
cmdCancel.Enabled = False

End Sub

Private Sub cmdCopyFile_Click()
cmdCancel.Enabled = True
cmdCopyFile.Enabled = False
lblStatus = "复制中..."
If chkOverwrite.Value = vbChecked Then
objBlockedIO.CopyFile txtSourceFile, txtDestinationFile, True, CLng(cmbBufferSize)
Else
objBlockedIO.CopyFile txtSourceFile, txtDestinationFile, , CLng(cmbBufferSize)
End If

End Sub

Private Sub Form_Load()
Dim copyPath As String
copyPath = App.Path + "\房屋信息表.mdb"
txtSourceFile.Text = copyPath
txtDestinationFile.Text = App.Path


cmbBufferSize.Text = 2048 'The default buffer size

Set objBlockedIO = New MyCopyClass

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set objBlockedIO = Nothing

End Sub



Private Sub objBlockedIO_CopyCancelled()

MsgBox "复制被用户取消！", vbCritical, "取消复制"
ProgressBar1.Value = 0
lblPercent.Caption = "0 %"
lblStatus = "复制"
cmdCopyFile.Enabled = True

End Sub

Private Sub objBlockedIO_CopyComplete()

MsgBox "复制完成", vbInformation, "复制完成"
ProgressBar1.Value = 0
lblPercent.Caption = "0 %"
lblStatus = "复制"
cmdCancel.Enabled = False
cmdCopyFile.Enabled = True

End Sub

Private Sub objBlockedIO_CopyError(strDescription As String)

MsgBox strDescription, vbExclamation, "复制错误！"
ProgressBar1.Value = 0
lblPercent.Caption = "0 %"
lblStatus = "复制"
cmdCancel.Enabled = False
cmdCopyFile.Enabled = True

End Sub

Private Sub objBlockedIO_CopyProgress(lngPercentDone As Long)

'On Error Resume Next

ProgressBar1.Value = lngPercentDone
lblPercent = lngPercentDone & " %"

End Sub
Private WithEvents objBlockedIO As MyCopyClass


Private Sub cmdCancel_Click()
objBlockedIO.Cancel
cmdCancel.Enabled = False

End Sub

Private Sub cmdCopyFile_Click()
cmdCancel.Enabled = True
cmdCopyFile.Enabled = False
lblStatus = "复制中..."
If chkOverwrite.Value = vbChecked Then
objBlockedIO.CopyFile txtSourceFile, txtDestinationFile, True, CLng(cmbBufferSize)
Else
objBlockedIO.CopyFile txtSourceFile, txtDestinationFile, , CLng(cmbBufferSize)
End If

End Sub

Private Sub Form_Load()
Dim copyPath As String
copyPath = App.Path + "\房屋信息表.mdb"
txtSourceFile.Text = copyPath
txtDestinationFile.Text = App.Path


cmbBufferSize.Text = 2048 'The default buffer size

Set objBlockedIO = New MyCopyClass

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set objBlockedIO = Nothing

End Sub



Private Sub objBlockedIO_CopyCancelled()

MsgBox "复制被用户取消！", vbCritical, "取消复制"
ProgressBar1.Value = 0
lblPercent.Caption = "0 %"
lblStatus = "复制"
cmdCopyFile.Enabled = True

End Sub

Private Sub objBlockedIO_CopyComplete()

MsgBox "复制完成", vbInformation, "复制完成"
ProgressBar1.Value = 0
lblPercent.Caption = "0 %"
lblStatus = "复制"
cmdCancel.Enabled = False
cmdCopyFile.Enabled = True

End Sub

Private Sub objBlockedIO_CopyError(strDescription As String)

MsgBox strDescription, vbExclamation, "复制错误！"
ProgressBar1.Value = 0
lblPercent.Caption = "0 %"
lblStatus = "复制"
cmdCancel.Enabled = False
cmdCopyFile.Enabled = True

End Sub

Private Sub objBlockedIO_CopyProgress(lngPercentDone As Long)

'On Error Resume Next

ProgressBar1.Value = lngPercentDone
lblPercent = lngPercentDone & " %"

End Sub

[lihonggen0]

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form CopyFile
BorderStyle = 1 'Fixed Single
Caption = "备份数据"
ClientHeight = 3135
ClientLeft = 3330
ClientTop = 3210
ClientWidth = 4830
Icon = "CopyFile.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 3135
ScaleWidth = 4830
Begin VB.CommandButton Copy
Caption = "备份"
Height = 375
Left = 2520
TabIndex = 5
Top = 2400
Width = 975
End
Begin VB.CommandButton Command1
Caption = "退出"
Height = 375
Left = 3600
TabIndex = 4
Top = 2400
Width = 975
End
Begin VB.TextBox Filepath
Height = 285
Left = 240
TabIndex = 3
Top = 480
Width = 3255
End
Begin VB.CommandButton Browsefile
Caption = "from"
Height = 375
Left = 3600
TabIndex = 2
Top = 480
Width = 975
End
Begin VB.TextBox Destinationpath
Enabled = 0 'False
Height = 285
Left = 240
TabIndex = 1
Top = 1080
Width = 3255
End
Begin VB.CommandButton copytopath
Caption = "To"
Enabled = 0 'False
Height = 375
Left = 3600
TabIndex = 0
Top = 1080
Width = 975
End
Begin MSComDlg.CommonDialog Dialog
Left = 360
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Flags = 6148
End
Begin ComctlLib.ProgressBar copybar
Height = 375
Left = 300
TabIndex = 9
Top = 1830
Width = 4095
_ExtentX = 7223
_ExtentY = 661
_Version = 327682
Appearance = 1
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Percent complete:"
Height = 195
Left = 360
TabIndex = 6
Top = 1545
Width = 1290
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "要备份的数据路径:"
Height = 180
Left = 240
TabIndex = 8
Top = 240
Width = 1530
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "备份数据的路径:"
Height = 180
Left = 240
TabIndex = 7
Top = 840
Width = 1350
End
End
Attribute VB_Name = "CopyFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Function CopyFile(Src As String, Dst As String) As Single
Static Buf As String
Dim needsize, Fizesize As Single
Dim Chunk, i2, i1 As Integer

Const BUFizesize = 1024

If Len(Dir(Dst)) Then
Response = MsgBox(Dst + Chr(10) + Chr(10) + "文件已存在，覆盖吗？", vbYesNo + vbQuestion) 'prompt the user with a message box
If Response = vbNo Then
Exit Function
Else
'如果文件存在，先删除文件
Kill Dst
End If
End If
' On Error GoTo FileCopyError
i1 = FreeFile
Open Src For Binary As i1
i2 = FreeFile
Open Dst For Binary As i2

Fizesize = LOF(i1)
needsize = Fizesize - LOF(i2)
Do
If needsize < BUFizesize Then
Chunk = needsize
Else
Chunk = BUFizesize
End If

Buf = String(Chunk, " ")
Get i1, , Buf
Put i2, , Buf
needsize = Fizesize - LOF(i2)
'显示copy进程
copybar.Value = (100 - Int(100 * needsize / Fizesize))

Loop Until needsize = 0
Close i1
Close i2
CopyFile = Fizesize
copybar.Value = 0
Exit Function

FileCopyError:
MsgBox "拷贝没有完成"
Close i1
Close i2
Exit Function

End Function


Public Function getpath(inpath As String) As String

Dim i As Integer
Dim outpath As String

On Error Resume Next

For i = Len(inpath) To 1 Step -1
If Mid(inpath, i, 1) = "\" Then
outpath = Mid(inpath, i + 1)
Exit For
End If
Next i

getpath = outpath

End Function

Private Sub copytopath_Click()
Dim br As BROWSEINFO
Dim hhh, ppp As Long
Dim path As String
Dim pos As Integer

br.hOwner = Me.hWnd
br.lpszTitle = "目标路径"
br.ulFlags = brF_RETURNONLYFSDIRS
ppp = SHBrowseForFolder(br)

path = Space(512)
T = SHGetPathFromIDList(ByVal ppp, ByVal path)

pos = InStr(path, Chr$(0))
inpath = Left(path, pos - 1)

If Right$(inpath, 1) = "\" Then
outpath = inpath
Else
outpath = inpath + "\"
End If
Destinationpath.Text = outpath + getpath(Filepath.Text)
End Sub

Private Sub Browsefile_Click()
Dialog.DialogTitle = "源文件路径"
Dialog.ShowOpen
Filepath.Text = Dialog.Filename
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Copy_Click()
On Error Resume Next

If Filepath.Text = "" Then
MsgBox "你没有选择拷贝文件", vbCritical
Exit Sub
End If
If Destinationpath.Text = "" Then
MsgBox "你没有选择目标路径", vbCritical
Exit Sub
End If

copybar.Value = CopyFile(Filepath.Text, Destinationpath.Text)
End Sub

Private Sub filepath_Change()
Destinationpath.Enabled = True
copytopath.Enabled = True
' Destinationpath.SetFocus
End Sub


Private Sub Form_Load()
Filepath.Text = "c:\ndr20001229\sftcc.mdb"
Destinationpath.Text = "c:\ndr20001229\backup\sftcc.mdb"
End Sub

[viena]

呵呵，CopyFile
Private Sub Copy_Click()
……
copybar.Value = CopyFile(Filepath.Text, Destinationpath.Text)
End Sub

[lihonggen0]

上面是自己写了copyFile这样一个函数
带进程条显示

Function CopyFile(Src As String, Dst As String) As Single
Static Buf As String
Dim needsize, Fizesize As Single
Dim Chunk, i2, i1 As Integer

Const BUFizesize = 1024

If Len(Dir(Dst)) Then
Response = MsgBox(Dst + Chr(10) + Chr(10) + "文件已存在，覆盖吗？", vbYesNo + vbQuestion) 'prompt the user with a message box
If Response = vbNo Then
Exit Function
Else
'如果文件存在，先删除文件
Kill Dst
End If
End If
' On Error GoTo FileCopyError
i1 = FreeFile
Open Src For Binary As i1
i2 = FreeFile
Open Dst For Binary As i2

Fizesize = LOF(i1)
needsize = Fizesize - LOF(i2)
Do
If needsize < BUFizesize Then
Chunk = needsize
Else
Chunk = BUFizesize
End If

Buf = String(Chunk, " ")
Get i1, , Buf
Put i2, , Buf
needsize = Fizesize - LOF(i2)
'显示copy进程
copybar.Value = (100 - Int(100 * needsize / Fizesize))

Loop Until needsize = 0
Close i1
Close i2
CopyFile = Fizesize
copybar.Value = 0
Exit Function

FileCopyError:
MsgBox "拷贝没有完成"
Close i1
Close i2
Exit Function

End Function

[yuanfen127]

这么多啊?可以说点原理不?