frmqycbkh.frm

朋友给的

Private Sub MEMO_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub
Private Sub Command4_Click()
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
'If BDHTH = "" Then
'        MsgBox "保单合同号不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
'    If TBXZ = "" Then
'        MsgBox "投保险种不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
'    If BXF = "" Then
'        MsgBox "保险费不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
'    If BXQX = "" Then
'        MsgBox "保险期限不能为空!!", vbCritical, "系统提示"
'        Exit Sub
'    End If
      If XH = "" Then
        MsgBox "序号不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
      If KHDJ = "" Then
        MsgBox "客户等级不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
      If DWMC = "" Then
        MsgBox "单位名称不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If

    If FZR = "" Then
        MsgBox "负责人不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
    If FZRZW = "" Then
        MsgBox "负责人职务不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If


    If JBR = "" Then
        MsgBox "经办人不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If

      If JBRZW = "" Then
        MsgBox "经办人职务不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
    rs.Open "select * from TBKHJBZL where xh='" & Trim(XH) & "'", gCnn, adOpenStatic, adLockPessimistic
    If rs.EOF Then
        rs.AddNew
    Else
        If MsgBox("确定修改序号为：" & XH & " 的企业资料？", vbYesNo, "修改询问") = vbNo Then
            Exit Sub
        End If
    
    End If

  rs.Fields("KHLX") = 1
  'rs.Fields("BDHTH") = Trim(BDHTH)
  'rs.Fields("TBXZ") = Trim(XH)
  'rs.Fields("BXF") = Trim(BXF)
  'rs.Fields("BXQX") = Trim(BXQX)
  'rs.Fields("TBRQ") = Trim(TBRQ)
  'rs.Fields("SXRQ") = Trim(SXRQ)
  'rs.Fields("XBRQ") = Trim(XBRQ)
  'rs.Fields("QTYD") = Trim(QTYD)
  rs.Fields("XH") = Trim(XH)
  rs.Fields("KHDJ") = Trim(KHDJ)
   rs.Fields("XSQD") = Trim(XSQD)
   rs.Fields("DWMC") = Trim(DWMC)
  rs.Fields("ADDRESS") = Trim(ADDRESS)
  rs.Fields("YZBM") = Trim(YZBM)
  rs.Fields("HY") = Trim(HY)
  rs.Fields("ZGRS") = Trim(ZGRS)
  rs.Fields("XYQK") = Trim(XYQK)
  rs.Fields("BXXQ") = Trim(BXXQ)
  rs.Fields("HTDQQK") = Trim(HTDQQK)
  rs.Fields("YJBX") = Trim(YJBX)
  rs.Fields("JCQK") = Trim(JCQK)
  rs.Fields("ZT") = Trim(ZT)
  rs.Fields("JZDS") = Trim(JZDS)
  rs.Fields("JDFX") = Trim(JDFX)
  rs.Fields("CGSBYJ") = Trim(CGSBYJ)
  rs.Fields("FZR") = Trim(FZR)
  rs.Fields("FZRXB") = Trim(FZRXB)
  rs.Fields("FZRNL") = Trim(FZRNL)
  rs.Fields("FZRXL") = Trim(FZRXL)
  rs.Fields("FZRZW") = Trim(FZRZW)
  rs.Fields("FZRBGDH") = Trim(FZRBGDH)
  rs.Fields("FZRSJ") = Trim(FZRSJ)
  rs.Fields("FZREMAIL") = Trim(FZREMAIL)
  rs.Fields("FZRADDRESS") = Trim(FZRADDRESS)
  rs.Fields("FZRJTDH") = Trim(FZRJTDH)
  rs.Fields("FZRSR") = Trim(FZRSR)
  rs.Fields("FZRGRAH") = Trim(FZRGRAH)
  rs.Fields("FZRXG") = Trim(FZRXG)
  rs.Fields("JBR") = Trim(JBR)
  rs.Fields("JBRXB") = Trim(JBRXB)
  rs.Fields("JBRNL") = Trim(JBRNL)
  rs.Fields("JBRXL") = Trim(JBRXL)
 rs.Fields("JBRZW") = Trim(JBRZW)
  rs.Fields("JBRBGDH") = Trim(JBRBGDH)
  rs.Fields("JBRCZ") = Trim(JBRCZ)
  rs.Fields("JBRSJ") = Trim(JBRSJ)
  rs.Fields("JBREMAIL") = Trim(JBREMAIL)
  rs.Fields("JBRADDRESS") = Trim(JBRADDRESS)
  rs.Fields("JBRJTDH") = Trim(JBRJTDH)
  rs.Fields("JBRSR") = Trim(JBRSR)
  rs.Fields("JBRGRAH") = Trim(JBRGRAH)
  rs.Fields("JBRXG") = Trim(JBRXG)
  rs.Fields("JSR") = Trim(JSR)
 rs.Fields("JSRLXDH") = Trim(JSRLXDH)
 rs.Fields("JSRJSTJ") = Trim(JSRJSTJ)
 rs.Fields("MEMO") = Trim(MEMO)
 rs.Update
 MsgBox "保存成功", vbOKOnly, "系统提示"
 ClearText
 KL.Tab = 0
 Call Form_Load
End Sub
Private Sub JBR_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub
Private Sub JBRXB_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub
Private Sub JBRXL_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub
Private Sub JBRZW_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub
Private Sub JBRBGDH_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub JBRSR_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub JBRGRAH_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub JBRXG_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub JBRNL_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub



Private Sub JBREMAIL_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub JBRADDRESS_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub JBRJTDH_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub JBRCZ_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub
Private Sub JBRSJ_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub




Private Sub Form_Load()
    If Me.WindowState = 0 Then Me.Move 0, 0, 14070, 8340
    Dim rs As New ADODB.Recordset
    Dim l As Integer
    Dim i As Long
    Dim msg As String
    Set rs = New ADODB.Recordset
    
    rs.Open "select * from PARAMETERS where paratype=1 order by valueid", gCnn, adOpenStatic, adLockPessimistic
   If Not rs.EOF Then
        For l = 0 To rs.RecordCount - 1
            KHDJ.AddItem rs("VALUE")
            rs.MoveNext
        Next l
    End If
    
    If rs.State = 1 Then rs.Close
    rs.Open "select * from VIEWTBQY", gCnn, adOpenStatic, adLockReadOnly
    findbt.Clear
    For i = 0 To rs.Fields.count - 1
        findbt.AddItem rs.Fields(i).name
    Next
        findbt.Text = "序号"
    If rs.State = 1 Then rs.Close
    strsql = "select 序号,单位名称 from  VIEWTBQY"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    ListView1.ColumnHeaders.Clear
    msg = ShowListView(ListView1, rs, False, "1,3500")
    QYLX = 0
    Command5.Enabled = False
End Sub

Private Sub ZT_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub

Private Sub FZRXL_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub
Private Sub ClearText()
'    BDHTH = ""
'        TBXZ = ""
'        BXF = ""
'        BXQX = ""
'        TBRQ = Now
'        SXRQ = Now
'        XBRQ = Now
         XH = ""
        KHDJ = ""
        XSQD = ""
        DWMC = ""
        ADDRESS = ""
        YZBM = ""
        HY = ""
        ZGRS = ""
        XYQK = ""
        BXXQ = ""
        HTDQQK = ""
        YJBX = ""
        JCQK = ""
        ZT = ""
        JZDS = ""
        JDFX = ""
        CGSBYJ = ""
        FZR = ""
        FZRXB = ""
        FZRNL = ""
        FZRXL = ""
        FZRZW = ""
        FZRBGDH = ""
        FZRSJ = ""
        FZREMAIL = ""
        FZRADDRESS = ""
        FZRJTDH = ""
        FZRSR = Now
        FZRGRAH = ""
        FZRXG = ""
        JBR = ""
        JBRXB = ""
        JBRNL = ""
        JBRXL = ""
        JBRZW = ""
        JBRBGDH = ""
        JBRJTDH = ""
        JSRJSTJ = ""
        JBRCZ = ""
        JBRSJ = ""
        JBREMAIL = ""
        JBRADDRESS = ""
        JBRGTDH = ""
        JBRSR = Now
        JBRGRAH = ""
        JBRXG = ""
        JSR = ""
        JSRLXDH = ""
        JSRTJ = ""
        MEMO = ""
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
 Dim i As Long
    If ListView1.ListItems.count > 0 Then
        For i = 1 To ListView1.ListItems.count
            If ListView1.ListItems(i).Selected Then
            Call FillText1(ListView1.ListItems(i).Text)
            End If
        Next
    End If
    
End Sub
Private Sub FillText1(CODE1 As String)
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    On Error GoTo ErrHandle
    strsql = "select * from VIEWTBQY "
    strsql = strsql & " where 序号 " & " like '%" & Trim(CODE1) & "%'"
    
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
         XH = rs("序号")
        KHDJ = rs("客户等级")
        XSQD = rs("销售渠道")
        DWMC = rs("单位名称")
        ADDRESS = rs("地址")
        YZBM = rs("邮政编码")
        HY = rs("行业")
        ZGRS = rs("职工人数")
        XYQK = rs("效益情况")
        BXXQ = rs("保险需求")
        HTDQQK = rs("原合同到期情况")
        YJBX = rs("预计保险")
        JCQK = rs("接触情况")
        ZT = rs("状态")
        JZDS = rs("竞争对手")
        JDFX = rs("焦点分析")
        CGSBYJ = rs("成功失败原因")
        FZR = rs("负责人")
        FZRXB = rs("负责人性别")
        FZRNL = rs("负责人年龄")
        FZRXL = rs("负责人学历")
        FZRZW = rs("负责人职务")
        FZRBGDH = rs("负责人办公电话")
        FZRSJ = rs("负责人手机")
        FZREMAIL = rs("负责人电子邮件")
        FZRADDRESS = rs("负责人家庭住址")
        FZRJTDH = rs("负责人家庭电话")
        FZRSR = rs("负责人生日")
        FZRGRAH = rs("负责人个人爱好")
        FZRXG = rs("负责人性格")
        JBR = rs("经办人")
        JBRXB = rs("经办人性别")
        JBRNL = rs("经办人年龄")
        JBRXL = rs("经办人学历")
        JBRZW = rs("经办人职务")
        JBRBGDH = rs("经办人办公电话")
        JBRCZ = rs("经办人办公传真")
        JBRSJ = rs("经办人手机")
        JBREMAIL = rs("经办人电子邮件")
        JBRADDRESS = rs("经办人家庭住址")
        JBRJTDH = rs("经办人家庭电话")
        JBRSR = rs("经办人生日")
        JBRGRAH = rs("经办人个人爱好")
        JBRXG = rs("经办人性格")
        JSR = rs("介绍人")
        JSRLXDH = rs("介绍人联系电话")
        JSRJSTJ = rs("介绍条件")
        MEMO = rs("备注")
        Command5.Enabled = True
        End If
    Exit Sub
ErrHandle:
        MsgBox Err.Description, vbCritical, "系统提示"
    
End Sub

Private Sub FillText(CODE1 As String, CODE2 As String)
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    On Error GoTo ErrHandle
    strsql = "select * from VIEWTBQY "
    strsql = strsql & " where " & Trim(CODE1) & " like '%" & Trim(CODE2) & "%'"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
         XH = rs("序号")
        KHDJ = rs("客户等级")
        XSQD = rs("销售渠道")
        DWMC = rs("单位名称")
        ADDRESS = rs("地址")
        YZBM = rs("邮政编码")
        HY = rs("行业")
        ZGRS = rs("职工人数")
        XYQK = rs("效益情况")
        BXXQ = rs("保险需求")
        HTDQQK = rs("原合同到期情况")
        YJBX = rs("预计保险")
        JCQK = rs("接触情况")
        ZT = rs("状态")
        JZDS = rs("竞争对手")
        JDFX = rs("焦点分析")
        CGSBYJ = rs("成功失败原因")
        FZR = rs("负责人")
        FZRXB = rs("负责人性别")
        FZRNL = rs("负责人年龄")
        FZRXL = rs("负责人学历")
        FZRZW = rs("负责人职务")
        FZRBGDH = rs("负责人办公电话")
        FZRSJ = rs("负责人手机")
        FZREMAIL = rs("负责人电子邮件")
        FZRADDRESS = rs("负责人家庭住址")
        FZRJTDH = rs("负责人家庭电话")
        FZRSR = rs("负责人生日")
        FZRGRAH = rs("负责人个人爱好")
        FZRXG = rs("负责人性格")
        JBR = rs("经办人")
        JBRXB = rs("经办人性别")
        JBRNL = rs("经办人年龄")
        JBRXL = rs("经办人学历")
        JBRZW = rs("经办人职务")
        JBRBGDH = rs("经办人办公电话")
        JBRCZ = rs("经办人办公传真")
        JBRSJ = rs("经办人手机")
        JBREMAIL = rs("经办人电子邮件")
        JBRADDRESS = rs("经办人家庭住址")
        JBRJTDH = rs("经办人家庭电话")
        JBRSR = rs("经办人生日")
        JBRGRAH = rs("经办人个人爱好")
        JBRXG = rs("经办人性格")
        JSR = rs("介绍人")
        JSRLXDH = rs("介绍人联系电话")
        JSRJSTJ = rs("介绍条件")
        MEMO = rs("备注")
        
        
        End If
    Exit Sub
ErrHandle:
        MsgBox Err.Description, vbCritical, "系统提示"
    
End Sub