contactman.frm

企业ERP系统里的网络邮件处理模块

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmcontact 
   Caption         =   "选择联系人"
   ClientHeight    =   3750
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6810
   Icon            =   "contactman.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3750
   ScaleWidth      =   6810
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdOk 
      Caption         =   "确定"
      Height          =   375
      Left            =   4080
      TabIndex        =   7
      Top             =   3240
      Width           =   1095
   End
   Begin VB.CommandButton CmdAddAll 
      Caption         =   ">>>>"
      Height          =   375
      Left            =   3240
      TabIndex        =   6
      Top             =   2160
      Width           =   855
   End
   Begin VB.CommandButton CmdEnd 
      Caption         =   "结束"
      Height          =   375
      Left            =   5520
      TabIndex        =   5
      Top             =   3240
      Width           =   1095
   End
   Begin VB.CommandButton CmdDelAll 
      Caption         =   "<<<<"
      Height          =   375
      Left            =   3240
      TabIndex        =   4
      Top             =   2640
      Width           =   855
   End
   Begin VB.CommandButton CmdDelete 
      Caption         =   "<<"
      Height          =   375
      Left            =   3240
      TabIndex        =   3
      Top             =   960
      Width           =   855
   End
   Begin VB.CommandButton CmdAdd 
      Caption         =   ">>"
      Height          =   375
      Left            =   3240
      TabIndex        =   2
      Top             =   480
      Width           =   855
   End
   Begin VB.ListBox LstMan 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3000
      Left            =   4320
      TabIndex        =   1
      Top             =   0
      Width           =   2415
   End
   Begin MSComctlLib.TreeView TrvAll 
      Height          =   3120
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   5503
      _Version        =   393217
      Indentation     =   647
      Style           =   7
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmcontact"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public rsMail As New ADODB.Recordset
Private Sub CmdAdd_Click()
Dim i As Integer
Dim ifhas As Boolean
If Not TrvAll.SelectedItem.Parent Is Nothing Then
    ifhas = False
    For i = 0 To LstMan.ListCount - 1
        If LstMan.List(i) = TrvAll.SelectedItem.Tag Then ifhas = True
    Next
    If ifhas = False Then
       LstMan.AddItem TrvAll.SelectedItem.Tag
    Else
       MsgBox "你已经添加了这个联系人！", vbOKOnly + vbInformation
    End If
End If
End Sub

Private Sub CmdAddAll_Click()
Dim i As Integer
LstMan.Clear
For i = 1 To TrvAll.Nodes.Count
    If Not TrvAll.Nodes(i).Parent Is Nothing Then
    LstMan.AddItem TrvAll.Nodes(i).Tag
    End If
Next i
End Sub

Private Sub CmdDelAll_Click()
  LstMan.Clear
End Sub

Private Sub CmdDelete_Click()
If LstMan.ListIndex <> -1 Then
    LstMan.RemoveItem LstMan.ListIndex
End If
End Sub

Private Sub CmdEnd_Click()
 Unload Me
End Sub

Private Sub CmdOk_Click()
Dim i As Integer
  If frmsend.clickone = "shou" Then
     For i = 0 To LstMan.ListCount - 1
         If i <> LstMan.ListCount - 1 Then
            frmsend.txtto.Text = frmsend.txtto.Text + LstMan.List(i) + ","
         Else
            frmsend.txtto.Text = frmsend.txtto.Text + LstMan.List(i)
         End If
     Next
  ElseIf frmsend.clickone = "chao" Then
     For i = 0 To LstMan.ListCount - 1
         If i <> LstMan.ListCount - 1 Then
            frmsend.txtreto.Text = frmsend.txtreto.Text + LstMan.List(i) + ","
         Else
            frmsend.txtreto.Text = frmsend.txtreto.Text + LstMan.List(i)
         End If
     Next
  ElseIf frmsend.clickone = "mi" Then
     For i = 0 To LstMan.ListCount - 1
         If i <> LstMan.ListCount - 1 Then
            frmsend.txtrecc.Text = frmsend.txtrecc.Text + LstMan.List(i) + ","
         Else
            frmsend.txtrecc.Text = frmsend.txtrecc.Text + LstMan.List(i)
         End If
     Next
  End If
  
  Unload Me
End Sub

Private Sub Form_Load()
   Dim rstemp As New ADODB.Recordset
   Dim node As node
   Dim i As Integer
   Dim n As Boolean
   If rsMail.RecordCount = 0 Then
      Exit Sub
   End If
   rsMail.Filter = ""
   rsMail.MoveFirst
   Do While Not rsMail.EOF
        If TrvAll.Nodes.Count = 0 Then
            TrvAll.Nodes.Add , , , rsMail.Fields("bk_group").Value
        Else
            n = False
            For i = 1 To TrvAll.Nodes.Count
                If rsMail.Fields("bk_group").Value = TrvAll.Nodes(i).Text Then n = True
            Next i
            If n = False Then TrvAll.Nodes.Add , , , rsMail.Fields("bk_group").Value
        End If
        rsMail.MoveNext
   Loop
      
   For i = 1 To TrvAll.Nodes.Count
       If TrvAll.Nodes(i).Parent Is Nothing Then
          rsMail.Filter = "bk_group='" & TrvAll.Nodes(i).Text & "'"
          
          Set rstemp = rsMail
          
          Do While Not rstemp.EOF
             Set node = TrvAll.Nodes.Add(TrvAll.Nodes(i).Index, tvwChild, , rstemp.Fields("name").Value & "<" & rstemp.Fields("emailaddress").Value & ">")
             node.Tag = rstemp.Fields("emailaddress").Value
             rstemp.MoveNext
          Loop
       End If
   Next i
End Sub