定时备份access数据库

来源:binghebbs.cn 点击数:14626 　 | 收藏 | 复制

时　间:2009-06-10 06:37:28
作　者:82077802 ID：4070 城市：杭州
摘　要:定时备份Access数据库
正　文:

Option Explicit
Private m_strHour As String, m_strMinuter As String, m_alreadyBak As Boolean
Private Sub Form_Load()
Dim strSourceFile, strDescriptionFile As String
Dim i As Long
For i = 0 To 23
      cboHour.AddItem i
Next i
For i = 0 To 59
      cboMinute.AddItem i
Next i
cboHour.ListIndex = 0
cboMinute.ListIndex = 0
txtSource.Text = ""
txtDescription.Text = ""
m_strHour = GetSetting("BakDataBase", "Time", "Hour")
If Len(m_strHour) = 0 Then Exit Sub
m_strMinuter = GetSetting("BakDataBase", "Time", "Minute")
strSourceFile = GetSetting("BakDataBase", "File", "SourcePath")
strDescriptionFile = GetSetting("BakDataBase", "File", "DestinationPath")
cboHour.Text = m_strHour
cboMinute.Text = m_strMinuter
txtSource.Text = strSourceFile
txtDescription.Text = strDescriptionFile
Timer1.Enabled = True
Timer1.Interval = 1000
Me.Caption = "开始定时备份！"
End Sub
Private Sub cmdDestination_Click()
Dim lngPos As Long, strFilePath As String, strDlgSelectFile As String
With DlgSelectFile
      .Filter = "数据库文件|*.mdb"
      .FileName = GetFileName(txtSource.Text)
      .ShowSave
End With
strDlgSelectFile = DlgSelectFile.FileName
If Len(strDlgSelectFile) > 0 Then
      lngPos = InStrRev(strDlgSelectFile, "\")
      If lngPos > 0 Then
         strFilePath = Date & " " & cboHour & "点" & cboMinute & "分备份" & _
                        Right$(strDlgSelectFile, Len(strDlgSelectFile) - lngPos)
         txtDescription.Text = Left$(strDlgSelectFile, lngPos) & strFilePath
      End If
End If
End Sub

Public Function GetFileName(FilePath$) As String
Dim pos&
pos& = InStrRev(FilePath$, "\")
If pos& > 0 Then
      GetFileName = Right$(FilePath, Len(FilePath) - pos&)
End If
End Function
Private Sub Timer1_Timer()
If Len(m_strHour) = 0 Then
      Timer1.Enabled = False
      Call Form_Load
End If
If Hour(Now) = Int(m_strHour) And Minute(Now) = Int(m_strMinuter) Then
      If m_alreadyBak = False Then
         FileCopy txtSource, txtDescription
         m_alreadyBak = True
      Else
         Timer1.Enabled = False
         m_alreadyBak = False
         Me.Caption = "定时备份数据库"
      End If
End If
End Sub
Private Sub cmdSource_Click()
With DlgSelectFile
      .Filter = "数据库文件|*.mdb"
      .ShowOpen
      If Len(.FileName) = 0 Then Exit Sub
      txtSource = .FileName
End With
End Sub
Private Sub cmdOk_Click()
Dim strFilePath As String, strDescription As String
Dim lngPos As Long
SaveSetting "BakDataBase", "Time", "Hour", cboHour
SaveSetting "BakDataBase", "Time", "Minute", cboMinute
SaveSetting "BakDataBase", "File", "SourcePath", txtSource
SaveSetting "BakDataBase", "File", "DestinationPath", txtDescription
m_strHour = cboHour
m_strMinuter = cboMinute
strDescription = txtDescription.Text
If Len(strDescription) > 0 Then
      lngPos = InStrRev(strDescription, "份")
      strFilePath = Date & " " & cboHour & "点" & cboMinute & "分备份" & _
                  Right$(strDescription, Len(strDescription) - lngPos)
      lngPos = InStrRev(strDescription, "\")
      txtDescription.Text = Left$(strDescription, lngPos) & strFilePath    '点确定后设置新的定时
End If
Me.Caption = "开始定时备份！"
Timer1.Enabled = True
Timer1.Interval = 1000
End Sub
Private Sub cmdExit_Click()
End
End Sub

Access软件网官方交流QQ群 (群号:54525238) 　　　　　　Access源码网店

【打印此文】【关闭窗口】