申告登记.frm

部门在用的用户申告系统

End If
If Len(Trim(Txtdhb.Text)) > 20 Then
   MsgBox "电话B内容超过20位", vbExclamation, "错误提示"
   Exit Sub
End If
If Len(Trim(Txtyb.Text)) > 10 Then
   MsgBox "邮政编码内容超过10位", vbExclamation, "错误提示"
   Exit Sub
End If

'检测服务卡数据
Dim fwk As String
Dim rsfwk As Recordset
fwk = Trim(Txtfwk.Text)
If fwk > "" Then
   If Chkbj.Value = 1 Then
      If Len(fwk) <> 13 Then
         Txtfwk.SetFocus
         MsgBox "发往开发部信息卡格式不正确！", vbExclamation, "错误信息"
         Exit Sub
      End If
   Else
      If Len(fwk) <> 10 Then
         Txtfwk.SetFocus
         MsgBox "发往开发部信息卡格式不正确！", vbExclamation, "错误信息"
         Exit Sub
      End If
   End If
   Set rsfwk = db.OpenRecordset("select fwbh from jfsg where fwbh>'' and fwbh='" & fwk & "'")
   If rsfwk.RecordCount > 0 Then
      rsfwk.Close
      Txtfwk.SetFocus
      MsgBox "服务卡或信息卡编号重复！", vbExclamation, "错误信息"
      Exit Sub
   End If
   rsfwk.Close
End If

If MsgBox("确认要添加吗？", vbQuestion + vbYesNo) = vbYes Then
   MousePointer = vbHourglass
    '省名信息
   Dim rsls As Recordset
   Dim rs As Recordset
   sm = Trim(Combosm.Text)
   jm = Trim(Combojm.Text)
   Set rsls = db.OpenRecordset("select * from jfxx where sm='" & sm & "' and jm='" & jm & "'")
   If rsls.RecordCount > 0 Then
      idjm = rsls.Fields!id
   Else
      Set rs = db.OpenRecordset("jfxx")
      If rs.RecordCount > 0 Then
         rs.MoveLast
      End If
      rs.AddNew
      rs.Fields!sm = sm
      rs.Fields!jm = jm
      rs.Update
      rs.MoveLast
      idjm = rs.Fields!id
      rs.Close
   End If
   rsls.Close
    '联系人信息
   If Combolxr.Text = "" Then
      lxr = "局方某人"
   Else
      lxr = Trim(Combolxr.Text)
   End If
   If Txtdha.Text = "" Then
      dha = ""
    Else
      dha = Trim(Txtdha.Text)
   End If
   If Txtdhb.Text = "" Then
      dhb = ""
    Else
      dhb = Trim(Txtdhb.Text)
   End If
   If Txtyb.Text = "" Then
      yb = ""
    Else
      yb = Trim(Txtyb.Text)
   End If
   If Txtdz.Text = "" Then
      dz = ""
    Else
      dz = Trim(Txtdz.Text)
   End If
   Set rsls = db.OpenRecordset("select * from jflx where lxr='" & lxr & "' and jfxxid=" & idjm)
   If rsls.RecordCount > 0 Then
      idlxr = rsls.Fields!id
   Else
      Set rs = db.OpenRecordset("jflx")
      If rs.RecordCount > 0 Then
         rs.MoveLast
      End If
      rs.AddNew
      rs.Fields!jfxxid = idjm
      rs.Fields!lxr = lxr
      rs.Fields!dha = dha
      rs.Fields!dhb = dhb
      rs.Fields!yb = yb
      rs.Fields!address = dz
      rs.Update
      rs.MoveLast
      idlxr = rs.Fields!id
      rs.Close
   End If
   rsls.Close
    '申告内容
   sgsj = Format(DTPicksg, "yyyy-mm-dd")
   clsj = Format(DTPickcl, "yyyy-mm-dd")
   clr = Trim(Comboclr.Text)
   cljg = Trim(Combojg.Text)
   If Txtsgnr.Text = "" Then
      sgnr = ""
    Else
      sgnr = Trim(Txtsgnr.Text)
   End If
   If Txtclff.Text = "" Then
      clff = ""
    Else
      clff = Trim(Txtclff.Text)
   End If
   If Txtfwk.Text = "" Then
      fwbh = ""
    Else
      fwbh = Trim(Txtfwk.Text)
   End If
   Set rsls = db.OpenRecordset("select * from jfsg where jflxid=" & idlxr & " and sgnr='" & sgnr & "' and sgsj='" & sgsj & "' and fwbh='" & fwbh & "'")
   If rsls.RecordCount > 0 Then
      rsls.Close
      MousePointer = vbDefault
      MsgBox "申告内容重复！", vbInformation, "信息"
      Txtsgnr.SetFocus
      Exit Sub
    Else
      rsls.Close
      Set rs = db.OpenRecordset("jfsg")
      If rs.RecordCount > 0 Then
         rs.MoveLast
      End If
      rs.AddNew
      rs.Fields!jflxid = idlxr
      rs.Fields!sgnr = sgnr
      rs.Fields!sgsj = sgsj
      rs.Fields!clff = clff
      rs.Fields!fwbh = fwbh
      rs.Fields!cljg = cljg
      rs.Fields!clr = clr
      rs.Fields!clsj = clsj
      rs.Update
      rs.Close
      MsgBox "添加记录成功！", vbInformation, "成功信息"
      Chkbj.Value = 0
      Combosm.Text = ""
      Combojm.Text = ""
      Combolxr.Text = ""
      Txtdha.Text = ""
      Txtdhb.Text = ""
      Txtyb.Text = ""
      Txtdz.Text = ""
      Txtsgnr.Text = ""
      Txtclff.Text = ""
      Txtfwk.Text = ""
      DTPicksg.Value = Date
      DTPickcl.Value = Date
   End If
End If
MousePointer = vbDefault
Exit Sub

err:
   MousePointer = vbDefault
   MsgBox err.Description, vbExclamation, "错误信息"
   
End Sub

Private Sub Cmdexit_Click()
Unload Me
End Sub

Private Sub Combojm_Change()
Call lxr
End Sub

Private Sub Combojm_Click()
Call lxr
End Sub

Private Sub Combojm_DblClick()
Combojm.Text = ""
End Sub

Private Sub Combolxr_Change()
Call lxrxx
End Sub

Private Sub Combolxr_Click()
Call lxrxx
End Sub

Private Sub Combolxr_DblClick()
Combolxr.Text = ""
End Sub

Private Sub Combosm_Change()
Call jm
End Sub

Private Sub Combosm_Click()
Call jm
End Sub

Private Sub Combosm_DblClick()
Combosm.Text = ""
End Sub

Private Sub Command1_Click()
Combosm.Text = ""
Combojm.Text = ""
Combolxr.Text = ""
Txtdha.Text = ""
Txtdhb.Text = ""
Txtyb.Text = ""
Txtdz.Text = ""
End Sub

Private Sub Form_Load()
MDIFrm.numsgdj.Enabled = False
MDIFrm.Caption = MDIFrm.Caption & "---[用户申告登记]"
Me.Top = 150
Me.Left = 1400
Me.Height = 6510
Me.Width = 9090
DTPicksg.Value = Date
DTPickcl.Value = Date
'初始化省明
Dim rssm As Recordset
Set rssm = db.OpenRecordset("select distinct sm from jfxx")
If rssm.RecordCount > 0 Then
   Do While Not rssm.EOF
      Combosm.AddItem rssm.Fields!sm
      rssm.MoveNext
   Loop
End If
rssm.Close

Combojg.AddItem "已处理"
Combojg.AddItem "未处理"
Combojg.AddItem "待观察"
Combojg.Text = "已处理"

Comboclr.AddItem "王顺利"
Comboclr.AddItem "何  伟"
Comboclr.AddItem "时金轩"
Comboclr.Text = "王顺利"
End Sub

Private Sub Form_Unload(Cancel As Integer)
MDIFrm.numsgdj.Enabled = True
MDIFrm.Caption = App.Title
End Sub

Private Sub jm()
Dim rsjm As Recordset
Set rsjm = db.OpenRecordset("select distinct jm from jfxx where sm='" & Trim(Combosm.Text) & "'")
Combojm.Clear
If rsjm.RecordCount > 0 Then
   Do While Not rsjm.EOF
      Combojm.AddItem rsjm.Fields!jm
      rsjm.MoveNext
   Loop
End If
rsjm.Close
Combojm.Text = Combojm.List(0)
End Sub

Private Sub lxr()
Dim rslxr As Recordset
Set rslxr = db.OpenRecordset("select lxr from jflx where jfxxid in (select id from jfxx where jm='" & Trim(Combojm.Text) & "')")
Combolxr.Clear
If rslxr.RecordCount > 0 Then
   Do While Not rslxr.EOF
      Combolxr.AddItem rslxr.Fields!lxr
      rslxr.MoveNext
   Loop
Else
    Combolxr.Text = ""
    Txtdha.Text = ""
    Txtdhb.Text = ""
    Txtyb.Text = ""
    Txtdz.Text = ""
End If
rslxr.Close
Combolxr.Text = Combolxr.List(0)
End Sub

Private Sub lxrxx()
Dim rslxrxx As Recordset
'Set rslxrxx = db.OpenRecordset("select * from jflx where lxr='" & Trim(Combolxr.Text) & "'")
Set rslxrxx = db.OpenRecordset("select dha,dhb,yb,address from jflx,jfxx where jflx.jfxxid=jfxx.id and lxr='" & _
              Trim(Combolxr.Text) & "' and sm='" & Combosm.Text & "' and jm='" & Combojm.Text & "'")
If rslxrxx.RecordCount > 0 Then
   Txtdha.Text = rslxrxx.Fields!dha
   Txtdhb.Text = rslxrxx.Fields!dhb
   Txtyb.Text = rslxrxx.Fields!yb
   Txtdz.Text = rslxrxx.Fields!address
Else
   Txtdha.Text = ""
   Txtdhb.Text = ""
   Txtyb.Text = ""
   Txtdz.Text = ""
End If
rslxrxx.Close
End Sub


'Private Sub Jiancefwk()
'Dim fwk As String
'Dim rsfwk As Recordset
'fwk = Trim(Txtfwk.Text)
'If fwk > "" Then
'   If Chkbj.Value = 1 Then
'      If Len(fwk) <> 13 Then
'         Txtfwk.SetFocus
'         MsgBox "发往开发部信息卡格式不正确！", vbExclamation, "错误信息"
'         Exit Sub
'      End If
'   Else
'      If Len(fwk) <> 10 Then
'         Txtfwk.SetFocus
'         MsgBox "发往开发部信息卡格式不正确！", vbExclamation, "错误信息"
'         Exit Sub
'      End If
'   End If
'   Set rsfwk = db.OpenRecordset("select fwbh from jfsg where fwbh>'' and fwbh='" & fwk & "'")
'   If rsfwk.RecordCount > 0 Then
'      rsfwk.Close
'      Txtfwk.SetFocus
'      MsgBox "服务卡或信息卡编号重复！", vbExclamation, "错误信息"
'      Exit Sub
'   End If
'   rsfwk.Close
'End If
'End Sub