VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmDataOutput 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "每月數據導出"
   ClientHeight    =   3735
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4845
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3735
   ScaleWidth      =   4845
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3510
      Top             =   660
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command3 
      Caption         =   "選擇路徑"
      Height          =   435
      Left            =   2910
      TabIndex        =   4
      Top             =   1560
      Width           =   1125
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "退出(&E)"
      Height          =   435
      Left            =   2880
      TabIndex        =   2
      Top             =   2820
      Width           =   1155
   End
   Begin VB.CommandButton Command1 
      Caption         =   "確定(&O)"
      Default         =   -1  'True
      Height          =   435
      Left            =   2880
      TabIndex        =   1
      Top             =   2280
      Width           =   1155
   End
   Begin VB.ListBox List1 
      BackColor       =   &H00C0FFFF&
      Height          =   2760
      Left            =   540
      TabIndex        =   0
      Top             =   570
      Width           =   1995
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "請選擇數據表"
      ForeColor       =   &H000000FF&
      Height          =   180
      Left            =   210
      TabIndex        =   3
      Top             =   270
      Width           =   1080
   End
End
Attribute VB_Name = "frmDataOutput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cn_access As New ADODB.Connection

Dim cn_sec As New ADODB.Connection
Dim rs_sec As New ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim comm As New ADODB.Command
Dim table_name As String
'Private td As TableDef
Private f As Field
Dim exist As Boolean
'Dim db As Database
Dim rsfield_sec As ADODB.Field
Dim rsfield As ADODB.Field


Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
CommonDialog1.CancelError = False
CommonDialog1.Filter = "ACCESS(*.mdb)|*.mdb|所有文件(*.*)|*.*"
CommonDialog1.DialogTitle = "選擇數據庫"
CommonDialog1.ShowOpen
If CommonDialog1.filename = "" Then
   Exit Sub
Else
    database_data = CommonDialog1.filename
    opendatabase CommonDialog1.filename
     Set rs = cn_access.OpenSchema(adSchemaTables)
     Do Until rs.EOF '遍歷備份目標數據庫中的所有數據表
        If rs!table_name = List1.Text Then '如果存在要備份的表名
           exist = True
        End If
        rs.MoveNext
     Loop
     If exist = False Then MsgBox "沒有可供備份的數據表！", vbOKOnly, "注意"
End If
End Sub

Private Sub Form_Load()
List1.AddItem "goodClass" '加入要導出數據的數據表名
List1.AddItem "goodInfo"
List1.AddItem "getInInfo"
List1.AddItem "getOutInfo"
End Sub
Private Function opendatabase(filename As String)
 Set cn_access = Nothing
 Set rs = Nothing
 Set comm = Nothing
 Set rsfield = Nothing
    cn_access.Provider = "Microsoft.Jet.OLEDB.4.0"
 On Error GoTo err
    cn_access.open filename
    Exit Function
err:
    Dim err As ADODB.Error
    Dim errstr As String
    If cn_access = "" Then
       MsgBox "沒有連接數據庫文件！"
    Else
        For Each err In conn.Errors
            errstr = errstr & "錯誤描述：" & err.Description & vbCr
        Next
            MsgBox errstr, vbOKOnly, "注意"
    End If
End Function

Private Sub Command1_Click()
If exist = True Then
   '此處進行數據的備份
  
   Call check_condatabase '連接系統數據庫
   Dim rs_back As ADODB.Recordset '目標數據庫的結果集
   Dim cn_back As ADODB.Connection '目標數據庫的連接
   Dim rs_source As ADODB.Recordset '源數據表的結果集
   
   Set rs_back = New ADODB.Recordset
   Set cn_back = New ADODB.Connection
       cn_back.Provider = "microsoft.jet.oledb.4.0"
       cn_back.ConnectionString = database_data
       cn_back.open
   Set rs_source = New ADODB.Recordset
       rs_back.open "select * from " & List1.Text & "", cn_back, adOpenStatic, adLockPessimistic
       If rs_back.RecordCount <> 0 Then '如果目標數據表中存在數據先進行清除
          If rs_back.State = 1 Then rs_back.close
          rs_back.open "delete * from " & List1.Text & "", cn_back, adOpenStatic, adLockPessimistic
       End If
       rs_source.open "select * from " & List1.Text & "", cn, adOpenStatic, adLockPessimistic
       If rs_back.State = 0 Then
          rs_back.open "select * from " & List1.Text & "", cn_back, adOpenStatic, adLockPessimistic
       End If
       If rs_source.BOF <> True And rs_source.EOF <> True Then
            Do Until rs_source.EOF '復制數據
               rs_back.AddNew
               For i = 0 To rs_source.Fields.Count - 1
                   rs_back.Fields(i).Value = rs_source.Fields(i).Value
               Next
               rs_source.MoveNext
               rs_back.Update
            Loop
            MsgBox "已經將數據表到處到指定的表中！", vbOKOnly, "成功"
        Else
            MsgBox "你所要備份的數據表中沒有數據！", vbOKOnly + vbCritical, "注意"
        End If
Else
   MsgBox "沒有可供備份的數據表！", vbOKOnly, "注意"
End If

End Sub