frmbackup.frm

this code is hospital system visualbasic

VERSION 5.00
Begin VB.Form frmbackup 
   Caption         =   "数据库备份"
   ClientHeight    =   2940
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5010
   Icon            =   "frmbackup.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2940
   ScaleWidth      =   5010
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   495
      Left            =   2520
      TabIndex        =   3
      Top             =   2190
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "备份数据"
      Height          =   495
      Left            =   2520
      TabIndex        =   2
      Top             =   1590
      Width           =   1215
   End
   Begin VB.DirListBox Dir1 
      Height          =   2190
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   1725
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   150
      TabIndex        =   0
      Top             =   150
      Width           =   1695
   End
   Begin VB.Label Label1 
      BackColor       =   &H8000000A&
      BackStyle       =   0  'Transparent
      Caption         =   "请选择你要备份数据库的路径，并输入你所要备份的文件的名称，然后按确定。"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   825
      Left            =   1980
      TabIndex        =   4
      Top             =   210
      Width           =   2760
   End
End
Attribute VB_Name = "frmbackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim choicedFile As String
Option Explicit
Private Sub Command1_Click()
    On Error GoTo errhandler
Set cnfeiyong = New ADODB.Connection
Set cnrmk = New ADODB.Connection
If cnfeiyong.State = 1 Then cnfeiyong.close
If cnrmk.State = 1 Then cnrmk.close

           Dim str2 As String
           Dim t As Integer
                Me.Caption = "正在备份文件，请等待....."
           Dim sourfile As String
           Dim yy As String
           yy = "YF_" & "YEAR(DATE)." & "mdb"
           Dim destfile As String
               sourfile = App.Path & "\data\yaofei.mdb"
               destfile = Dir1.Path
           If destfile <> "" Then
                FileCopy sourfile, App.Path & "\DATA_BACK\BAK_yaofei.MDB"
           End If
           Me.Caption = "备份数据库"
           MsgBox "数据库备份完成！", vbOKOnly, "完成"
           Exit Sub
errhandler:
    MsgBox ERR.Description, vbOKOnly, "错误"
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub



Private Sub Drive1_Change()

     Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Load()
    Drive1.Drive = "d:"
   
End Sub