form1.frm

功能强大的个人工作通讯录

If err.Description <> "" Then
    MsgBox "列表中没有项目！", 0 + 64, "Error"
End If

End Sub


Private Sub simpleCZ_Click()
'-----------------------------当查询条件为“所有项目时"

If simpleCombo = "所有项目" Then
    Me.lv.ListItems.clear '先清空listview
    Call OpenConn
   sql = "select * from 来往记录"
   rs.Open sql, cn, 3, 3
   
    For i = 0 To rs.Fields.Count - 1
        xmmc = rs.Fields(i).Name
               
            Call OpenConn1
       sql1 = "select * from 来往记录 where " & xmmc & " like '%" & simpleKeyWord & "%'"
            rs1.Open sql1, cn1, 3, 3
            If rs1.RecordCount > 0 Then
               Do While Not rs1.EOF
                    Set Item = lv.FindItem(rs1.Fields("记录序号"), , , lvwPartial) '判断是否是重复客户
                    If Item Is Nothing Then
                        it = 1
                    Else
                        it = 0
                    End If
                    
                     If it = 1 Then
                      Set addlist = lv.ListItems.add(, , IIf(IsNull(rs1.Fields(rs1.Fields(0).Name)), "", rs1.Fields(rs1.Fields(0).Name)), , 0)
                           
                        For h = 1 To rs1.Fields.Count - 1
                     
                        addlist.SubItems(h) = IIf(IsNull(rs1.Fields(rs1.Fields(h).Name)), "", rs1.Fields(rs1.Fields(h).Name))
                      
                        Next h
                     End If
                     
                    rs1.MoveNext
               Loop
            End If
           Call CloseConn1
     Next i
     
    Call CloseConn

    Label3.Caption = "查询结果：" & lv.ListItems.Count & "条记录"
    Exit Sub
End If

'-----------------------------当查询条件非“所有项目时"
sqlH = "select * from 来往记录 where " & simpleCombo & " like '%" & simpleKeyWord & "%'"
Call addxx

Label3.Caption = "查询结果：" & lv.ListItems.Count & "条记录"

End Sub
Private Sub simpleKeyWord_keypress(KeyAscii As Integer)
If KeyAscii = 13 Then
    simpleCZ_Click
End If
End Sub
Private Sub fixKeyWord_keypress(KeyAscii As Integer)
If KeyAscii = 13 Then
    fixCZ_Click
End If
End Sub
Private Sub logicKeyWord3_keypress(KeyAscii As Integer)
If KeyAscii = 13 Then
    logicCZ_Click
End If
End Sub

Private Sub logicCZ_Click()
Call logicWord

If logicKeyWord1 <> "" Then
    key1 = logicCombo1 & " like '%" & logicKeyWord1 & "%'"
Else
    key1 = ""
End If
'================================================================
If logicKeyWord2 <> "" Then
    key2 = logicCombo2 & " like '%" & logicKeyWord2 & "%'"
Else
    key2 = ""
End If
'================================================================
If logicKeyWord3 <> "" Then
    key3 = logicCombo3 & " like '%" & logicKeyWord3 & "%'"
Else
    key3 = ""
End If
'================================================================
If Log1 = " NOT " Then
    Log1 = " AND "
    key2 = Replace(key2, "like", "NOT like")
End If

If Log2 = " NOT " Then
    Log2 = " AND "
    key3 = Replace(key3, "like", "NOT like")
End If

sqlH2 = "select distinct * from 来往记录 where " & key1 & Log1 & key2 & Log2 & key3
Call Addxx2

Label1.Caption = "查询结果：" & lv2.ListItems.Count & "条记录"

End Sub

Sub delHxx() '删除选中项目过程模块
On Error GoTo err

 Dim nCount     As Integer
          Dim nIndex     As Integer
          Dim oitem     As ListItem
    If listV.ListItems.Count = 0 Then
        MsgBox "列表中没有可操作的项目！", vbOKOnly, "提示"
        Exit Sub
    End If
    
    If MsgBox("此操作将删除所有选中项目的联系人信息以及来往记录，是否继续操作？", vbYesNo, "确认删除") = vbNo Then Exit Sub
    
          With listV
                  nCount = .ListItems.Count
                  For nIndex = nCount To 1 Step -1
                          If .ListItems.Item(nIndex).Selected = True Or .ListItems.Item(nIndex).Checked = True Then

                         '------------------------------------------------------删除对应编号联系人的来往记录
                                 Call OpenConn
                                sql = "select * from 来往记录 where 记录序号=" & .ListItems.Item(nIndex).Text
                                rs.Open sql, cn, 3, 3
                                Do While Not rs.EOF
                                   rs.delete
                                   rs.Update
                                   rs.MoveNext
                                Loop
                                Call CloseConn
                        '------------------------------------------------------列表中删除选中项
                                .ListItems.Remove nIndex '
                          End If
                  Next
          End With
  
err:
  If err.Description <> "" Then
    MsgBox "没有选中的项目或操作错误"
  End If
  
End Sub

Sub addxx()
On Error GoTo err
 '----------------------------------------------------加载默认列表项目
    lv.ColumnHeaders.clear '清除列头
    
  
    Call OpenConn
    rs.Open sqlH, cn, 3, 3
    
    Me.lv.ListItems.clear
    
    For i = 0 To rs.Fields.Count - 1
    
        Me.lv.ColumnHeaders.add = rs.Fields(i).Name
        
        Next i
    
    lv.ColumnHeaders(1).Width = 800
    
    
    lv.ListItems.clear '清除列表项目
         
If rs.RecordCount > 0 Then
    
    Do While Not rs.EOF
    
        Set addlist = lv.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 0)
        
       
            For k = 1 To rs.Fields.Count - 1
         
            addlist.SubItems(k) = IIf(IsNull(rs.Fields(rs.Fields(k).Name)), "", rs.Fields(rs.Fields(k).Name))
          
        Next k
        
        rs.MoveNext
    Loop

 End If

Call CloseConn

'----------------------设置前四列列宽
lv.ColumnHeaders(1).Width = 1000
lv.ColumnHeaders(2).Width = 800
lv.ColumnHeaders(3).Width = 1500
lv.ColumnHeaders(4).Width = 1500
lv.ColumnHeaders(5).Width = 1600
lv.ColumnHeaders(6).Width = 1600
lv.ColumnHeaders(7).Width = 1500

t = 1
Label3.Caption = "共" & lv.ListItems.Count & "条记录"
err:
 If err.Description <> "" Then
 End If
End Sub


Sub addxx1()
On Error GoTo err
 '----------------------------------------------------加载默认列表项目
    lv1.ColumnHeaders.clear '清除列头
    
  
    Call OpenConn
    rs.Open sqlH1, cn, 3, 3
    
    Me.lv1.ListItems.clear
    
    For i = 0 To rs.Fields.Count - 1
    
        Me.lv1.ColumnHeaders.add = rs.Fields(i).Name
        
        Next i
    
    lv1.ColumnHeaders(1).Width = 800
    
    
    lv1.ListItems.clear '清除列表项目
         
If rs.RecordCount > 0 Then
    
    Do While Not rs.EOF
    
        Set addlist = lv1.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 0)
        
       
            For k = 1 To rs.Fields.Count - 1
         
            addlist.SubItems(k) = IIf(IsNull(rs.Fields(rs.Fields(k).Name)), "", rs.Fields(rs.Fields(k).Name))
          
        Next k
        
        rs.MoveNext
    Loop

 End If

Call CloseConn

'----------------------设置前四列列宽
lv1.ColumnHeaders(1).Width = 1000
lv1.ColumnHeaders(2).Width = 800
lv1.ColumnHeaders(3).Width = 1500
lv1.ColumnHeaders(4).Width = 1500
lv1.ColumnHeaders(5).Width = 1600
lv1.ColumnHeaders(6).Width = 1600
lv1.ColumnHeaders(7).Width = 1500

t = 1

Label4.Caption = "共" & lv1.ListItems.Count & "条记录"
err:
 If err.Description <> "" Then
 End If
End Sub

Sub Addxx2()
On Error GoTo err
 '----------------------------------------------------加载默认列表项目
    lv2.ColumnHeaders.clear '清除列头
    
  
    Call OpenConn
    rs.Open sqlH2, cn, 3, 3
    
    Me.lv2.ListItems.clear
    
    For i = 0 To rs.Fields.Count - 1
    
        Me.lv2.ColumnHeaders.add = rs.Fields(i).Name
        
        Next i
    
    lv2.ColumnHeaders(1).Width = 800
    
    
    lv2.ListItems.clear '清除列表项目
         
If rs.RecordCount > 0 Then
    
    Do While Not rs.EOF
    
        Set addlist = lv2.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 0)
        
       
            For k = 1 To rs.Fields.Count - 1
         
            addlist.SubItems(k) = IIf(IsNull(rs.Fields(rs.Fields(k).Name)), "", rs.Fields(rs.Fields(k).Name))
          
        Next k
        
        rs.MoveNext
    Loop

 End If

Call CloseConn

'----------------------设置前四列列宽
lv2.ColumnHeaders(1).Width = 1000
lv2.ColumnHeaders(2).Width = 800
lv2.ColumnHeaders(3).Width = 1500
lv2.ColumnHeaders(4).Width = 1500
lv2.ColumnHeaders(5).Width = 1600
lv2.ColumnHeaders(6).Width = 1600
lv2.ColumnHeaders(7).Width = 1500

t = 1
 Label1.Caption = "共" & lv2.ListItems.Count & "条记录"
err:
 If err.Description <> "" Then
 End If
End Sub
Sub logicWord()

If logicKeyWord1 = "" Then
    Log1 = ""
    logicCombo4 = ""
Else
    Select Case logicCombo4
        Case "且"
            Log1 = " AND "
        Case "或"
            Log1 = " OR "
        Case "非"
            Log1 = " NOT "
    End Select
    
End If

If logicKeyWord3 = "" Then
    Log2 = ""
    logicCombo5 = ""
Else
    Select Case logicCombo5
        Case "且"
            Log2 = " AND "
        Case "或"
            Log2 = " OR "
        Case "非"
            Log2 = " NOT "
    End Select
    
End If

If logicKeyWord2 = "" Then
    Log1 = ""
    logicCombo4 = ""
End If

If logicKeyWord1 = "" And logicKeyWord2 = "" Then
    Log1 = ""
    Log2 = ""
    logicCombo4 = ""
    logicCombo5 = ""
End If

End Sub