frmbackdate.frm

VB库存管理系统

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmBackDate 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "备份数据库"
   ClientHeight    =   4695
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5325
   Icon            =   "FrmBackDate.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4695
   ScaleWidth      =   5325
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdBackup 
      Caption         =   "备  份"
      Height          =   375
      Left            =   2280
      TabIndex        =   4
      Top             =   3960
      Width           =   1215
   End
   Begin VB.CommandButton CmdQuit 
      Caption         =   "退  出"
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   3960
      Width           =   1095
   End
   Begin VB.TextBox TxtDir 
      Height          =   375
      Left            =   1920
      TabIndex        =   2
      Top             =   1200
      Width           =   3255
   End
   Begin MSComDlg.CommonDialog dlgFileSave 
      Left            =   2400
      Top             =   2160
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "备份到："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   960
      Width           =   1695
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFFFFF&
      Caption         =   "建议：为了保证数据库的最大完整性，建议用户做完每次操作后，要进行备份数据库，从而减少不必要的数据丢失！！！"
      Height          =   855
      Left            =   2280
      TabIndex        =   0
      Top             =   2280
      Width           =   2775
   End
   Begin VB.Image Image1 
      Height          =   4710
      Left            =   0
      Picture         =   "FrmBackDate.frx":08CA
      Top             =   0
      Width           =   3075
   End
End
Attribute VB_Name = "FrmBackDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'备份数据库功能
'实现方法:把kcgl.mdb拷贝到要保存的路径中,并把后缀名改为.bk,是安全起见.
Option Explicit
Dim strPath As String      '备份目录
Dim strFileName As String  '备份文件名


Private Sub CmdBackup_Click()

'    Dim MyYear As String            '年
'    Dim MyMonth As String           '月
'    Dim MyDay As String             '日
'    Dim strDate As String           '日期
    Dim SourceFile As String        '原文件名
    Dim DestinationFile As String   '目的文件
    Dim fName As String
    
    On Error GoTo ErrorLine
    '打开对话框
    With dlgFileSave
        .CancelError = True
        .DialogTitle = "请选择要导出文件的目录和文件名"
        .Filter = "备份文件(*.bk)|*.bk"
        .FilterIndex = 1
        .ShowSave
    End With

    fName = dlgFileSave.FileName
    TxtDir.Text = fName
    Me.Caption = "正在备份数据,请稍候..."
                    '关闭连接
                    Set rs = Nothing
'                    Set Gconn = Nothing
                    Set Con = Nothing
  SourceFile = App.Path & "\" & "kcgl.mdb"          '   指定源文件名。
  DestinationFile = fName '   指定目的文件名。
  
  Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim y As Variant
y = fso.CopyFile(App.Path & "\kcgl.mdb", fName)
  
'  FileCopy SourceFile, DestinationFile           '   将源文件的内容复制到目的文件中。
  MsgBox "备份成功!"
  Me.Caption = "备份数据成功"
  Me.MousePointer = vbDefault
ErrorLine:
    MsgBox "请输入要保存文件名称!"
    CmdBackup.SetFocus
    Exit Sub
    
End Sub



Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
frmMDIMain.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
frmMDIMain.Enabled = True
End Sub

Private Sub TxtDir_Change()
    CmdBackup.Enabled = True
End Sub