frmbxgxgl.frm

朋友给的

      End
      Begin VB.Label Label6 
         Caption         =   "E-MAIL"
         Height          =   375
         Left            =   3435
         TabIndex        =   20
         Top             =   2250
         Width           =   1530
      End
      Begin VB.Label Label5 
         Caption         =   "传真"
         Height          =   375
         Left            =   300
         TabIndex        =   19
         Top             =   2250
         Width           =   1530
      End
      Begin VB.Label Label4 
         Caption         =   "邮编"
         Height          =   375
         Left            =   3435
         TabIndex        =   18
         Top             =   1695
         Width           =   1530
      End
      Begin VB.Label Label3 
         Caption         =   "联系电话"
         Height          =   375
         Left            =   300
         TabIndex        =   17
         Top             =   1695
         Width           =   1530
      End
      Begin VB.Label Label2 
         Caption         =   "公司名称"
         Height          =   375
         Left            =   300
         TabIndex        =   16
         Top             =   1110
         Width           =   1530
      End
      Begin VB.Label Label1 
         Caption         =   "代号"
         Height          =   375
         Left            =   300
         TabIndex        =   15
         Top             =   570
         Width           =   1530
      End
   End
End
Attribute VB_Name = "frmBXGXGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub ADDRESS_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub



Private Sub Command1_Click()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    On Error GoTo ErrHandle
    If DH = "" Then
        MsgBox "代号不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
    If Trim(MC) = "" Then
        MsgBox "名称不能为空!!", vbCritical, "系统提示"
        Exit Sub
    End If
    strsql = "select * from bxgs where dh='" & DH & "'"
    rs.Open strsql, gCnn, adOpenStatic, adLockOptimistic
    If rs.EOF Then
        rs.AddNew
    Else
        If MsgBox("确定修改代号为：" & DH & " 的保险公司资料？", vbYesNo, "修改询问") = 1 Then
            Exit Sub
        End If
    End If
        rs("dh") = Trim(DH)
        rs("mc") = Trim(MC)
        rs("lxdh") = Trim(LXDH)
        rs("yb") = Trim(YB)
        rs("cz") = Trim(CZ)
        rs("email") = Trim(EMAIL)
        rs("address") = Trim(ADDRESS)
        rs("fzr") = Trim(FZR)
        rs("fzrdh") = Trim(FZRDH)
        rs("lxr") = Trim(LXR)
        rs("lxrdh") = Trim(LXRDH)
        rs("memo") = Trim(MEMO)
    rs.Update
    MsgBox "添加成功!!", vbInformation, "系统提示"
    ClearText
    Exit Sub
    
ErrHandle:
    MsgBox Err.Description, "系统提示"

End Sub
Private Sub ClearText()
    DH = ""
    MC = ""
    LXDH = ""
    YB = ""
    ADDRESS = ""
    FZR = ""
    EMAIL = ""
    CZ = ""
    FZRDH = ""
    LXR = ""
    LXRDH = ""
    MEMO = ""


End Sub
Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim msg As String
    Dim strsql As String
    strsql = "select 代号,名称 from  viewbxgs"
    If Trim(Findbt) <> "" And Trim(findnr) <> "" Then
        strsql = strsql & " where " & Findbt & " like '%" & findnr & "%'"
    End If
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If rs.RecordCount = 1 Then
        FillText (rs("代号"))
    ElseIf rs.RecordCount > 1 Then
        msg = ShowListView(LstBXGS, rs, False, "1000, 4000")
    End If
    
    





End Sub

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

End Sub

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

End Sub

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

End Sub



Private Sub Findnr_LostFocus()
'    Findnr = "查找内容"
End Sub

Private Sub Form_Load()
    If Me.WindowState = 0 Then Me.Move 0, 0, 12000, 6945
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim i As Long
    On Error GoTo ErrHandle
    rs.Open "select * from viewBXGS", gCnn, adOpenStatic, adLockReadOnly
    Findbt.Clear
    For i = 0 To rs.Fields.count - 1
        Findbt.AddItem rs.Fields(i).name
    Next
    
    Dim msg As String
    Dim strsql As String
    strsql = "select 代号,名称 from  viewbxgs"
    If rs.State = 1 Then rs.Close
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    msg = ShowListView(LstBXGS, rs, False, "1000, 4000")
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    Exit Sub
ErrHandle:
    MsgBox Err.Description, vbCritical, "系统提示"
    
End Sub
Private Sub FillText(DHCODE As String)
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    On Error GoTo ErrHandle
    strsql = "select * from viewbxgs where 代号='" & Trim(DHCODE) & "'"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
         DH = rs("代号")
        MC = rs("名称")
        LXDH = rs("联系电话")
        YB = rs("邮编")
        CZ = rs("传真")
        EMAIL = rs("电子邮件")
        ADDRESS = rs("地址")
        FZR = rs("负责人")
        FZRDH = rs("负责人电话")
        LXR = rs("联系人")
        LXRDH = rs("联系人电话")
        MEMO = rs("备注")
    End If
    Exit Sub
ErrHandle:
        MsgBox Err.Description, vbCritical, "系统提示"
    
End Sub


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

End Sub

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

End Sub

Private Sub LstBXGS_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Dim i As Long
    If LstBXGS.ListItems.count > 0 Then
        For i = 1 To LstBXGS.ListItems.count
            If LstBXGS.ListItems(i).Selected Then
                FillText (LstBXGS.ListItems(i).Text)
            End If
        Next
        
        
        
    End If
    







End Sub

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

End Sub

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

End Sub

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

End Sub

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

End Sub

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

End Sub

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

End Sub