frm_数据接收.frm

计量器具管理系统

         EndProperty
         ForeColor       =   &H80000008&
         Height          =   210
         Left            =   1440
         TabIndex        =   5
         Top             =   285
         Width           =   1260
      End
      Begin VB.Shape Shape2 
         BackStyle       =   1  'Opaque
         BorderColor     =   &H00FF8080&
         Height          =   2520
         Left            =   75
         Top             =   75
         Width           =   4260
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H00FF8080&
         Height          =   2460
         Left            =   30
         Top             =   30
         Width           =   4200
      End
   End
   Begin VB.Label Label2 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      Caption         =   "检测单位名称为:"
      ForeColor       =   &H00FF0000&
      Height          =   180
      Left            =   90
      TabIndex        =   17
      Top             =   3120
      Width           =   1350
   End
End
Attribute VB_Name = "Frm_数据接收"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dirs As String
Dim CONNS As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rst As New ADODB.Recordset
Dim DWMCS As String
Dim JsID As Integer

Private Sub Dir1_Change()
    If Right(Trim(Dir1.Path), 1) = "\" Then
        dirs = Dir1.Path
    Else
        dirs = Dir1.Path + "\"
    End If
    Label7.Caption = dirs
End Sub

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

Private Sub Form_Load()
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) * (1 - 0.618)
    TxtSBDW.Enabled = False
    TxtSBNR.Enabled = False
    TxtSBRQ.Enabled = False
    TxtSBR.Enabled = False
    Pic4.Visible = False
    Label7.Caption = Dir1.Path
End Sub

Private Sub SNXpEXIT_Click()
    Unload Me
End Sub

Private Sub SNXpOK_Click()
    If Trim(DWMCS) = "" Then
        MsgBox "请先通过数据检测来测试上报数据的合法性!", vbCritical, " 提示"
        Exit Sub
    End If
    If CONNS.State <> 1 Then Exit Sub
    '检测以前是否接收过此单位数据
    Pic4.Visible = True
    DoEvents
    Conn.Execute "delete from dwxx where dwmc='" & DWMCS & "'"
    Conn.Execute "delete from bmxx where dwmc='" & DWMCS & "'"
    Conn.Execute "delete from jlqjxx where dwmc='" & DWMCS & "'"
    Conn.Execute "delete from jlqjjd where dwmc='" & DWMCS & "'"
    Conn.Execute "delete from jlqjbf where dwmc='" & DWMCS & "'"
    Conn.Execute "delete from jlqjwx where dwmc='" & DWMCS & "'"
    
    
    '接收数据上报信息

    '接收单位信息
    If rst.State = 1 Then rst.Close
    
    rst.Open "select * from dwxx where dwmc='" & DWMCS & "'", CONNS

    PBar.Min = 0
    PBar.Value = 0
    PBar.Max = rst.RecordCount + 2
    Do While rst.EOF = False
        PBar.Value = PBar.Value + 1
        Conn.Execute "insert into dwxx(dwmc,dz,lxr,dh,jydw,jylxr,jydh ) values ('" & Trim(rst!Dwmc) & "','" & Trim(rst!dz) & "','" & Trim(rst!lxr) & "','" & Trim(rst!dh) & "','" & Trim(rst!jydw) & "','" & Trim(rst!jylxr) & "','" & Trim(rst!jydh) & "')"
        rst.MoveNext
    Loop
    '接收部门信息
    If rst.State = 1 Then rst.Close
    rst.Open "select * from bmxx", CONNS
''    If rs.State = 1 Then rs.Close
''    rs.Open "select * from bmxx", conn, adOpenKeyset, adLockOptimistic
    PBar.Min = 0
    PBar.Value = 0
    PBar.Max = rst.RecordCount + 2
    Do While rst.EOF = False
        PBar.Value = PBar.Value + 1
        Conn.Execute "insert into bmxx(dwmc,bmbh,bmmc,fzr) values ('" & Trim(rst!Dwmc) & "','" & Trim(rst!bmbh) & "','" & Trim(rst!bmmc) & "','" & Trim(rst!fzr) & "')"
        rst.MoveNext
    Loop
    '接收器具信息
    If rst.State = 1 Then rst.Close
    rst.Open "select * from jlqjxx", CONNS
    PBar.Min = 0
    PBar.Value = 0
    PBar.Max = rst.RecordCount + 2
    Do While rst.EOF = False
        PBar.Value = PBar.Value + 1
'        Conn.Execute "insert into jlqjxx(dwmc,bh,mc,lb,zb,dj,zt ,ggxh,clfw,fdz,sccj,ccbh,sybm,syz,qyrq,bfrq,jdrq,jdzq,zqdw,jddw,jdjg,jlsj) values ('" & Trim(rst!Dwmc) & "','" & Trim(rst!Bh) & "','" & Trim(rst!Mc) & "','" & Trim(rst!lb) & "','" & Trim(rst!zb) & "','" & Trim(rst!dj) & "','" & Trim(rst!zt) & "','" & Trim(rst!ggxh) & "','" & Trim(rst!clfw) & "','" & Trim(rst!fdz) & "','" & Trim(rst!sccj) & "','" & Trim(rst!ccbh) & "','" & Trim(rst!sybm) & "','" & Trim(rst!syz) & "','" & Trim(rst!qyrq) & "','" & Trim(rst!bfrq) & "','" & Trim(rst!jdrq) & "'," & rst!Jdzq & " , '" & Trim(rst!Zqdw) & "','" & Trim(rst!Jddw) & "','" & Trim(rst!jdjg) & "','" & Trim(rst!jlsj) & "')"
        rst.MoveNext
    Loop
    '接收计量器具检定信息
    If rst.State = 1 Then rst.Close
    rst.Open "select * from jlqjjd", CONNS
    PBar.Min = 0
    PBar.Value = 0
    PBar.Max = rst.RecordCount + 2
    Do While rst.EOF = False
        PBar.Value = PBar.Value + 1
        Conn.Execute "insert into jlqjjd(dwmc,bh,mc,zt_h,bcjdrq,bcjddw,bcjdjg,jlsj) values ('" & Trim(rst!Dwmc) & "','" & Trim(rst!Bh) & "','" & Trim(rst!Mc) & "','" & Trim(rst!zt_h) & "','" & Trim(rst!bcjdrq) & "','" & Trim(rst!Bcjddw) & "','" & Trim(rst!bcjdjg) & "','" & Trim(rst!jlsj) & "')"
        rst.MoveNext
    Loop
    '接收计量器具报废信息
'    If rst.State = 1 Then rst.Close
'    rst.Open "select * from jlqjbf", CONNS
'    PBar.Min = 0
'    PBar.Value = 0
'    PBar.Max = rst.RecordCount + 2
'    Do While rst.EOF = False
'        PBar.Value = PBar.Value + 1
'        Conn.Execute "insert into jlqjbf(dwmc,bh,mc,zt_q,zt_h,bfrq,shr,bz,jlsj) values ('" & Trim(rst!Dwmc) & "','" & Trim(rst!Bh) & "','" & Trim(rst!Mc) & "','" & Trim(rst!zt_q) & "','" & Trim(rst!zt_h) & "','" & Trim(rst!bfrq) & "','" & Trim(rst!shr) & "','" & Trim(rst!bz) & "','" & Trim(rst!jlsj) & "')"
'        rst.MoveNext
'    Loop
    '接收计量器具维修信息
    If rst.State = 1 Then rst.Close
    rst.Open "select * from jlqjwx", CONNS
    PBar.Min = 0
    PBar.Value = 0
    PBar.Max = rst.RecordCount + 2
    Do While rst.EOF = False
        PBar.Value = PBar.Value + 1
        Conn.Execute "insert into jlqjwx(dwmc,bh,mc, wxyy,wxjg,wxrq,wxdw,wxr, jlsj) values ('" & Trim(rst!Dwmc) & "','" & Trim(rst!Bh) & "','" & Trim(rst!Mc) & "','" & Trim(rst!wxyy) & "','" & Trim(rst!wxjg) & "','" & Trim(rst!wxrq) & "','" & Trim(rst!WXdw) & "','" & Trim(rst!wxr) & "',#" & Trim(rst!jlsj) & "#)"
        rst.MoveNext
    Loop
    
    Pic4.Visible = False
    MsgBox "数据接收成功！", , "远望提示"
    Unload Me
    DoEvents
End Sub


Private Sub SNXpSJJC_Click()
On Error GoTo ERR
    Dim obj As Object
    Set obj = CreateObject("Scripting.FileSystemObject")
    If IsNull(obj) = True Then
        MsgBox "文件系统错误！", vbInformation, "远望计量器具管理——错误信息"
        rs.Filter = ""
        Exit Sub
    End If
    If Right(Trim(Dir1.Path), 1) = "\" Then
        dirs = Dir1.Path
    Else
        dirs = Dir1.Path + "\"
    End If
    '''检测文件
    If obj.FileExists(dirs & "数据上报.mdb") = False Then
        MsgBox "选择的路径没有找到所需要的文件！！！", vbInformation, "数据接收"
        Exit Sub
    End If
    
    Dim rst1 As New ADODB.Recordset
    
    If CONNS.State = 1 Then CONNS.Close
    CONNS.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Dir1.Path & "\数据上报.mdb;Persist Security Info=False"
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from DWXX", CONNS, adOpenStatic, adLockReadOnly
    If rst.EOF = True Then
        MsgBox "接收的上报数据发生错误，请通知重新上报！", vbCritical, "数据接收"
        CONNS.Close
        Exit Sub
    Else
        DWMCS = Trim(rst!Dwmc)
        If Trim(DWMCS) = "" Then
            MsgBox "数据检测没有检测到上报单位名称!", vbCritical, "提示"
        Else
            MsgBox "数据检测成功！", vbInformation, "提示"
            TxtSBDW = DWMCS
            SNXpOK.Enabled = True
        End If
    End If
    Exit Sub
ERR:
    MsgBox ERR.Description
End Sub