frm_数据上报.frm

计量器具管理系统

         Left            =   1110
         TabIndex        =   6
         Top             =   1530
         Width           =   2730
         _ExtentX        =   4815
         _ExtentY        =   609
         _Version        =   393216
         Format          =   24903681
         CurrentDate     =   38511
      End
      Begin VB.TextBox TxtSBR 
         Height          =   350
         Left            =   1110
         TabIndex        =   7
         Top             =   2025
         Width           =   2730
      End
      Begin VB.TextBox TxtSBNR 
         Height          =   350
         Left            =   1110
         TabIndex        =   5
         Top             =   1020
         Width           =   2730
      End
      Begin VB.TextBox TxtSBDW 
         Height          =   350
         Left            =   1110
         TabIndex        =   4
         Top             =   525
         Width           =   2730
      End
      Begin VB.Label Label6 
         Alignment       =   2  'Center
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "上报登记"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   210
         Left            =   1710
         TabIndex        =   14
         Top             =   210
         Width           =   855
      End
      Begin VB.Label Label5 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "上报人"
         ForeColor       =   &H80000008&
         Height          =   180
         Left            =   270
         TabIndex        =   13
         Top             =   2115
         Width           =   540
      End
      Begin VB.Label Label4 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "上报内容"
         ForeColor       =   &H80000008&
         Height          =   180
         Left            =   270
         TabIndex        =   12
         Top             =   1110
         Width           =   720
      End
      Begin VB.Label Label3 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "登记日期"
         ForeColor       =   &H80000008&
         Height          =   180
         Left            =   270
         TabIndex        =   10
         Top             =   1605
         Width           =   720
      End
      Begin VB.Label Label2 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "上报单位"
         ForeColor       =   &H80000008&
         Height          =   180
         Left            =   270
         TabIndex        =   8
         Top             =   600
         Width           =   720
      End
      Begin VB.Shape Shape2 
         BorderColor     =   &H00FF8080&
         Height          =   2400
         Left            =   60
         Top             =   120
         Width           =   4005
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H00FF8080&
         Height          =   2400
         Left            =   15
         Top             =   75
         Visible         =   0   'False
         Width           =   3945
      End
   End
   Begin VB.Label Label7 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   90
      TabIndex        =   16
      Top             =   2730
      Width           =   90
   End
End
Attribute VB_Name = "Frm_数据上报"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim obj As Object
Dim rs As New ADODB.Recordset
Dim dirs As String


Private Sub Dir1_Change()
    If Right(Trim(Dir1.Path), 1) = "\" Then
        dirs = Dir1.Path
    Else
        dirs = Dir1.Path + "\"
    End If
    Label7.Caption = "上报内容保存位置 " & dirs + "数据上报.mdb"
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Activate()
''On Error GoTo err:
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select *  from dwxx", Conn, adOpenKeyset, adLockOptimistic
    If rs.EOF = False Then
        Txtsbdw.Text = Trim(rs!Dwmc)
        DTPsbrq.Value = Date
        Txtsbdw.Enabled = False
''        TxtSBNR.Enabled = False
        DTPsbrq.Enabled = False
''        TxtSBR.Enabled = False
        SNXpOK.Enabled = True
    Else
        Exit Sub
    End If
'''err:
'''    MsgBox err.Description
'''    Exit Sub
End Sub

Private Sub Form_Load()
''On err GoTo err:
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) * (1 - 0.618)
    '建立文件系统
    Set obj = CreateObject("Scripting.FileSystemObject")
    If IsNull(obj) = True Then
        MsgBox "文件系统错误！", vbInformation, "计量器具管理系统——错误信息"
        Unload Me
        Exit Sub
    End If
    
''err:
''    MsgBox err.Description
End Sub

Private Sub SNXpCancel_Click()
    Unload Me
End Sub


Private Sub SNXpOK_Click()
''On Error GoTo err:

''    If rs.State = 1 Then rs.Close
''    rs.Open "select sbrq as 上报日期,sbnr as 上报内容,sbdw as 上报单位,dwmc as 单位名称,sbr as 上报人 from JS_SB", conn, adOpenKeyset, adLockOptimistic
''    conn.Execute "delete from JS_SB"
''    rs.AddNew
''    rs!上报日期 = Trim(DTPsbrq.Value)
''    rs!上报内容 = Trim(TxtSBNR.Text)
''    rs!上报单位 = Trim(TxtSBDW.Text)
''    rs!单位名称 = Trim(TxtSBDW.Text)
''    rs!上报人 = Trim(TxtSBR.Text)
''    rs.Update
    
    If Label7.Caption = "" Then
        MsgBox "请先选择数据存放位置", , "远望提示"
        Exit Sub
    End If
    If MsgBox("您确定填写无误并上报本次数据吗？", vbOKCancel, "远望提示") = vbOK Then
        If obj.FileExists(dirs & "数据上报.mdb") = False Then
            obj.copyfile App.Path + "\MEMS.mdb", dirs & "\数据上报.mdb", True
            MsgBox "数据上报完成！", vbInformation, "远望提示"
'''            conn.Execute "delete from JS_SB where sbnr='" & Trim(TxtSBNR) & "'"
            Exit Sub
        ElseIf MsgBox("所选择的路径已经存有上次上报的数据，是否将原有上报数据覆盖？", vbYesNo + vbDefaultButton2, "覆盖或者更改备份路径") = vbYes Then
            obj.DeleteFile dirs & "\数据上报.mdb", True
            obj.copyfile App.Path + "\MEMS.mdb", dirs & "数据上报.mdb", True
            MsgBox "数据上报完成！", vbInformation, "远望提示"
            Grid.Visible = False
            
'''            conn.Execute "delete from JS_SB where sbnr='" & Trim(TxtSBNR) & "'"
            Exit Sub
        End If
    Else
        Conn.Execute "delete from data_sb where sbrq='" & DTPsbrq.Value & "'"
        Grid.Visible = False
        Exit Sub
    End If
''err:
''    MsgBox err.Description
''    Exit Sub
End Sub

Private Sub SNXpSBDJ_Click()
        
    If rs.State = 1 Then rs.Close
    rs.Open "select * from data_sb", Conn, adOpenKeyset, adLockOptimistic
    rs.AddNew
    
    rs!sbdw = Trim(Txtsbdw.Text)
    rs!sbnr = Trim(TxtSBNR.Text)
    rs!sbrq = Trim(CDate(DTPsbrq.Value))
    rs!sbr = Trim(TxtSBR.Text)
    rs.Update
    Set Grid.DataSource = rs
    Grid.Visible = True
End Sub