frmbackup.frm

此为我2001年为东莞建发楦头开发的企业管理软件他们使用至今,望斑竹指教! 其他会员最好不要随意下载,需经斑竹同意或我本人同意,谢谢!

VERSION 5.00
Begin VB.Form frmbackup 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据备份...."
   ClientHeight    =   1860
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4635
   Icon            =   "Frmbackup.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1860
   ScaleWidth      =   4635
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdok 
      Caption         =   "开始备份&S"
      Height          =   375
      Left            =   960
      TabIndex        =   3
      Top             =   1320
      Width           =   1215
   End
   Begin VB.CommandButton cmdcancel 
      Caption         =   "关闭&C"
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   1320
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "选项"
      Height          =   1095
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4335
      Begin VB.Label lblstatus 
         Caption         =   "备份整个数据库资料......"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   375
         Left            =   600
         TabIndex        =   1
         Top             =   480
         Width           =   3015
      End
   End
End
Attribute VB_Name = "frmbackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fso As New FileSystemObject
Public dbs As Connection

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdok_Click()

   On Error GoTo err
    Dim dbname As String
    Dim monthvalue As String
    
    dbname = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)
    monthvalue = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)

    value1 = MsgBox("确认真的备份数据吗  备份后的数据库为：" & dbname & ".mdb ?", vbQuestion + vbOKCancel, "提示信息")
    If value1 <> 1 Then Exit Sub
    
    dbname = App.Path & "\" & dbname & ".mdb"
    
    If fso.FileExists(dbname) Then
        If MsgBox("文件已存在，是否覆盖？", vbYesNo + vbQuestion) = vbNo Then
            Exit Sub
        Else
            fso.DeleteFile dbname
        End If
    End If
    
    
    lblStatus.Caption = "正在备份数据库  请稍候........."
    lblStatus.Refresh
    cmdok.Enabled = False
    cmdCancel.Enabled = False
        
    Set fso = New FileSystemObject
    fso.CopyFile App.Path & "\data.mdb", dbname, True
    Set dbs = New Connection
    dbs.Open "PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & dbname & ";Jet OLEDB:Database "

    dbs.Execute "select * into client from [odbc;dsn=jfdata;database=jfdata].client "
    dbs.Execute "select * into everyday from [odbc;dsn=jfdata;database=jfdata].everyday "
    dbs.Execute "select * into model from [odbc;dsn=jfdata;database=jfdata].model "
    dbs.Execute "select * into sn_detail from [odbc;dsn=jfdata;database=jfdata].sn_detail "
    dbs.Execute "select * into sn_mas from [odbc;dsn=jfdata;database=jfdata].sn_mas "
    dbs.Execute "select * into tap from [odbc;dsn=jfdata;database=jfdata].tap "
    dbs.Execute "select * into tap_detail from [odbc;dsn=jfdata;database=jfdata].tap_detail"
    dbs.Execute "select * into sproduce1 from [odbc;dsn=jfdata;database=jfdata].sproduce1 "
    dbs.Execute "select * into din from [odbc;dsn=jfdata;database=jfdata].din "
    dbs.Execute "select * into ti_mas from [odbc;dsn=jfdata;database=jfdata].ti_mas "
    dbs.Execute "select * into ti_detail from [odbc;dsn=jfdata;database=jfdata].ti_detail"
    dbs.Execute "select * into sproduce2 from [odbc;dsn=jfdata;database=jfdata].sproduce2"

    dbs.Close

    If fso.FolderExists(App.Path & "\temp") = True Then
        fso.DeleteFolder App.Path & "\temp"
    End If
    
    fso.CreateFolder App.Path & "\temp"
    fso.CopyFile App.Path & "\" & monthvalue & ".mdb", App.Path & "\temp" & "\" & monthvalue & "1" & ".mdb"
    fso.DeleteFile App.Path & "\" & monthvalue & ".mdb"
    DBEngine.CompactDatabase App.Path & "\temp\" & monthvalue & "1" & ".mdb", App.Path & "\temp\" & monthvalue & ".mdb"
    
    fso.DeleteFile App.Path & "\temp\" & monthvalue & "1" & ".mdb"
    fso.CopyFile App.Path & "\temp\" & monthvalue & ".mdb", App.Path & "\" & monthvalue & ".mdb"
    fso.DeleteFile App.Path & "\temp\" & monthvalue & ".mdb"
    fso.DeleteFolder App.Path & "\temp"
    MsgBox "备份数据完毕！！！", vbInformation, "提示信息"
    cmdok.Enabled = True
    cmdCancel.Enabled = True
    cmdok.Caption = "开始备份&S"
    
    lblStatus.Caption = "数据库备份完毕........"
    lblStatus.Refresh

    Exit Sub
err:
    If Not (err.number = cdlCancel) Then ShowError
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Resize()
'On Error Resume Next
'Me.Top = 0
'Me.Left = 50
End Sub