dlgss7testtype.frm

电力机车牵引变压器试验站总控程序

      Begin VB.Frame Frame3 
         Caption         =   "基本数据录入"
         Height          =   3495
         Left            =   -74160
         TabIndex        =   5
         Top             =   720
         Width           =   4575
         Begin VB.CommandButton Command15 
            Caption         =   "..."
            Height          =   375
            Left            =   3960
            TabIndex        =   56
            Top             =   2760
            Width           =   375
         End
         Begin VB.TextBox Text1 
            Height          =   495
            Index           =   0
            Left            =   2280
            TabIndex        =   6
            Top             =   480
            Width           =   1575
         End
         Begin VB.TextBox Text1 
            Height          =   495
            Index           =   1
            Left            =   2280
            TabIndex        =   7
            Top             =   1200
            Width           =   1575
         End
         Begin VB.TextBox Text1 
            Height          =   495
            Index           =   2
            Left            =   2280
            TabIndex        =   8
            Top             =   1920
            Width           =   1575
         End
         Begin VB.TextBox Text1 
            Height          =   495
            Index           =   3
            Left            =   2280
            TabIndex        =   9
            Top             =   2640
            Width           =   1575
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "变压器型号"
            Height          =   195
            Left            =   600
            TabIndex        =   13
            Top             =   480
            Width           =   900
         End
         Begin VB.Label Label2 
            AutoSize        =   -1  'True
            Caption         =   "变压器编号"
            Height          =   195
            Left            =   600
            TabIndex        =   12
            Top             =   1320
            Width           =   900
         End
         Begin VB.Label Label3 
            AutoSize        =   -1  'True
            Caption         =   "试验员"
            Height          =   195
            Left            =   600
            TabIndex        =   11
            Top             =   2040
            Width           =   540
         End
         Begin VB.Label Label4 
            AutoSize        =   -1  'True
            Caption         =   "试验日期"
            Height          =   195
            Left            =   600
            TabIndex        =   10
            Top             =   2880
            Width           =   720
         End
      End
      Begin VB.CommandButton Command1 
         Caption         =   "保存试验数据"
         Enabled         =   0   'False
         Height          =   495
         Left            =   -68760
         TabIndex        =   4
         Top             =   6000
         Width           =   1455
      End
      Begin VB.CommandButton Command2 
         Caption         =   "开始试验"
         Height          =   495
         Left            =   -68760
         TabIndex        =   3
         Top             =   5400
         Width           =   1455
      End
      Begin VB.Image Image1 
         BorderStyle     =   1  'Fixed Single
         Height          =   1875
         Index           =   3
         Left            =   -60960
         Picture         =   "dlgSS7Testtype.frx":2110
         Top             =   1200
         Width           =   4485
      End
      Begin VB.Image Image1 
         BorderStyle     =   1  'Fixed Single
         Height          =   1875
         Index           =   2
         Left            =   -61080
         Picture         =   "dlgSS7Testtype.frx":8B6A
         Top             =   1320
         Width           =   4485
      End
      Begin VB.Image Image1 
         BorderStyle     =   1  'Fixed Single
         Height          =   1875
         Index           =   1
         Left            =   14520
         Picture         =   "dlgSS7Testtype.frx":F5C4
         Top             =   1080
         Width           =   4485
      End
      Begin VB.Image Image1 
         BorderStyle     =   1  'Fixed Single
         Height          =   1875
         Index           =   0
         Left            =   -60720
         Picture         =   "dlgSS7Testtype.frx":1601E
         Top             =   840
         Width           =   4485
      End
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   10440
      TabIndex        =   1
      Top             =   14520
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "OK"
      Height          =   375
      Left            =   7200
      TabIndex        =   0
      Top             =   14520
      Width           =   1215
   End
End
Attribute VB_Name = "dlgSS7Testtype"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub Command1_Click()
    ProgressBar4.Visible = True
    Frame8.Visible = True
    Call saveSS7DWord
    
    Dim cn As Object
    Dim rs As Object

    Dim i As Integer
    Dim Y As Integer
    Dim x As Integer
    
    Set cn = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
    cn.Open
    rs.CursorLocation = 3

    rs.Open "select * from 变压器试验结果1 where 试验日期 like '" & byqData(4) & "'", cn, adOpenKeyset, adLockBatchOptimistic
    
    If rs.Recordcount = 0 Then
        rs.Close
        
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 变压器试验结果1", cn, adOpenKeyset, adLockBatchOptimistic
        

        x = rs.Fields.count
        If rs.Recordcount <> 0 Then
            rs.MoveLast
        End If
        rs.AddNew
        
        For i = 0 To x - 1
           rs.Fields(i) = byqData(i)
        Next i
        rs.UpdateBatch
        rs.Close
        
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 变压器试验结果2", cn, adOpenKeyset, adLockBatchOptimistic

        Y = rs.Fields.count
        If rs.Recordcount <> 0 Then
            rs.MoveLast
        End If
        rs.AddNew
        For i = 0 To 4
            rs.Fields(i) = byqData(i)
        Next i
        For i = 5 To Y - 1
            rs.Fields(i) = byqData(i + 234)
        Next i
        rs.UpdateBatch
        rs.Close
        
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 电抗器试验结果", cn, adOpenKeyset, adLockBatchOptimistic

        Y = rs.Fields.count
        If rs.Recordcount <> 0 Then
            rs.MoveLast
        End If
        rs.AddNew
        
        For i = 0 To 206
            rs.Fields(i) = dkqData(i)
        Next i
        rs.UpdateBatch
        rs.Close
        
        Set cn = CreateObject("adodb.connection")
        Set rs = CreateObject("adodb.recordset")
        cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
        cn.Open
        rs.CursorLocation = 3
        
        rs.Open "select * from 互感器试验结果", cn, adOpenKeyset, adLockBatchOptimistic

        Y = rs.Fields.count
        If rs.Recordcount <> 0 Then
            rs.MoveLast
        End If
        rs.AddNew
        
        For i = 0 To 21
            rs.Fields(i) = hgqData(i)
        Next i
        rs.UpdateBatch
        rs.Close
        
        
        MsgBox "数据存档完毕"
        ProgressBar4.Value = ProgressBar4.Max
        Frame8.Visible = False
        ProgressBar4.Visible = False
     Else
        Dim x1 As Integer
        x1 = MsgBox("数据已存在!是否覆盖?", 4 + 0 + 64, "注意")
        If x1 = 6 Then
            rs.Filter = "试验日期 = '" & byqData(4) & "'"
            rs.Delete
            rs.UpdateBatch
            rs.Close
            Set cn = CreateObject("adodb.connection")
            Set rs = CreateObject("adodb.recordset")
            cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
            cn.Open
            rs.CursorLocation = 3
        
            rs.Open "select * from 变压器试验结果2 where 试验日期 like '" & byqData(4) & "'", cn, adOpenKeyset, adLockBatchOptimistic
            rs.Filter = "试验日期 = '" & byqData(4) & "'"
            rs.Delete
            rs.UpdateBatch
            rs.Close
            
            Set cn = CreateObject("adodb.connection")
            Set rs = CreateObject("adodb.recordset")
            cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
            cn.Open
            rs.CursorLocation = 3
            
            rs.Open "select * from 变压器试验结果1", cn, adOpenKeyset, adLockBatchOptimistic
            
            x = rs.Fields.count
            If rs.Recordcount <> 0 Then
                rs.MoveLast
            End If
            rs.AddNew
            
            For i = 0 To x - 1
               rs.Fields(i) = byqData(i)
            Next i
            rs.UpdateBatch
            rs.Close
                     
            Set cn = CreateObject("adodb.connection")
            Set rs = CreateObject("adodb.recordset")
            cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
            cn.Open
            rs.CursorLocation = 3
            
            rs.Open "select * from 变压器试验结果2", cn, adOpenKeyset, adLockBatchOptimistic
            
            Y = rs.Fields.count
            If rs.Recordcount <> 0 Then
                rs.MoveLast
            End If
            rs.AddNew
            For i = 0 To 4
                rs.Fields(i) = byqData(i)
            Next i
            For i = 5 To Y - 1
                rs.Fields(i) = byqData(i + 234)
            Next i
            rs.UpdateBatch
            rs.Close
            
            Set cn = CreateObject("adodb.connection")
            Set rs = CreateObject("adodb.recordset")
            cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
            cn.Open
            rs.CursorLocation = 3
            
            rs.Open "select * from 电抗器试验结果 where 试验日期 like '" & dkqData(4) & "'", cn, adOpenKeyset, adLockBatchOptimistic
            rs.Filter = "试验日期 = '" & dkqData(4) & "'"
            rs.Delete
            rs.UpdateBatch
            rs.Close
            
            Set cn = CreateObject("adodb.connection")
            Set rs = CreateObject("adodb.recordset")
            cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
            cn.Open
            rs.CursorLocation = 3
            
            rs.Open "select * from 电抗器试验结果", cn, adOpenKeyset, adLockBatchOptimistic
    
            Y = rs.Fields.count
            If rs.Recordcount <> 0 Then
                rs.MoveLast
            End If
            rs.AddNew
            
            For i = 0 To 206
                rs.Fields(i) = dkqData(i)
            Next i
            rs.UpdateBatch
            rs.Close
            
            Set cn = CreateObject("adodb.connection")
            Set rs = CreateObject("adodb.recordset")
            cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
            cn.Open
            rs.CursorLocation = 3
            
            rs.Open "select * from 互感器试验结果 where 试验日期 like '" & hgqData(4) & "'", cn, adOpenKeyset, adLockBatchOptimistic
            rs.Filter = "试验日期 = '" & dkqData(4) & "'"
            rs.Delete
            rs.UpdateBatch
            rs.Close
            
            Set cn = CreateObject("adodb.connection")
            Set rs = CreateObject("adodb.recordset")
            cn.ConnectionString = "uid=admin;pwd=111;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & "\试验结果1.mdb;Persist Security Info=False"
            cn.Open
            rs.CursorLocation = 3
            
            rs.Open "select * from 互感器试验结果", cn, adOpenKeyset, adLockBatchOptimistic
    
            Y = rs.Fields.count
            If rs.Recordcount <> 0 Then
                rs.MoveLast
            End If
            rs.AddNew
            
            For i = 0 To 21
                rs.Fields(i) = hgqData(i)
            Next i
            rs.UpdateBatch
            rs.Close