frmsendemail.vb

来自「<Visual Basic 数据库开发实例精粹(第二版)>一书首先介」· VB 代码 · 共 614 行 · 第 1/2 页

VB
614
字号
    Me.labSendDept.BackColor = System.Drawing.SystemColors.Control
    Me.labSendDept.Cursor = System.Windows.Forms.Cursors.Default
    Me.labSendDept.ForeColor = System.Drawing.SystemColors.ControlText
    Me.labSendDept.Location = New System.Drawing.Point(14, 22)
    Me.labSendDept.Name = "labSendDept"
    Me.labSendDept.RightToLeft = System.Windows.Forms.RightToLeft.No
    Me.labSendDept.Size = New System.Drawing.Size(54, 17)
    Me.labSendDept.TabIndex = 21
    Me.labSendDept.Text = "发件人:"
    '
    'labEMailTitle
    '
    Me.labEMailTitle.AutoSize = True
    Me.labEMailTitle.BackColor = System.Drawing.SystemColors.Control
    Me.labEMailTitle.Cursor = System.Windows.Forms.Cursors.Default
    Me.labEMailTitle.ForeColor = System.Drawing.SystemColors.ControlText
    Me.labEMailTitle.Location = New System.Drawing.Point(14, 47)
    Me.labEMailTitle.Name = "labEMailTitle"
    Me.labEMailTitle.RightToLeft = System.Windows.Forms.RightToLeft.No
    Me.labEMailTitle.Size = New System.Drawing.Size(42, 17)
    Me.labEMailTitle.TabIndex = 19
    Me.labEMailTitle.Text = "主题:"
    '
    'grpDeptList
    '
    Me.grpDeptList.Anchor = CType(((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
                Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
    Me.grpDeptList.BackColor = System.Drawing.SystemColors.Control
    Me.grpDeptList.Controls.Add(Me.tlvClient)
    Me.grpDeptList.Controls.Add(Me.chkShowInGroup)
    Me.grpDeptList.Controls.Add(Me.tcboClientType)
    Me.grpDeptList.Controls.Add(Me.labReceiveList)
    Me.grpDeptList.ForeColor = System.Drawing.SystemColors.ControlText
    Me.grpDeptList.Location = New System.Drawing.Point(525, 28)
    Me.grpDeptList.Name = "grpDeptList"
    Me.grpDeptList.RightToLeft = System.Windows.Forms.RightToLeft.No
    Me.grpDeptList.Size = New System.Drawing.Size(195, 406)
    Me.grpDeptList.TabIndex = 23
    Me.grpDeptList.TabStop = False
    '
    'tlvClient
    '
    Me.tlvClient.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
                Or System.Windows.Forms.AnchorStyles.Left) _
                Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
    Me.tlvClient.CheckBoxes = System.Windows.Forms.CheckBoxesTypes.Recursive
    Me.tlvClient.Columns.AddRange(New System.Windows.Forms.ColumnHeader() {Me.ColumnHeader1})
    Me.tlvClient.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
    Me.tlvClient.HideSelection = False
    Me.tlvClient.Location = New System.Drawing.Point(8, 84)
    Me.tlvClient.Name = "tlvClient"
    Me.tlvClient.Size = New System.Drawing.Size(178, 311)
    Me.tlvClient.SmallImageList = Me.ImgListListViewS
    Me.tlvClient.Sorting = System.Windows.Forms.SortOrder.None
    Me.tlvClient.TabIndex = 46
    '
    'ColumnHeader1
    '
    Me.ColumnHeader1.Width = 100
    '
    'ImgListListViewS
    '
    Me.ImgListListViewS.ImageSize = New System.Drawing.Size(16, 16)
    Me.ImgListListViewS.ImageStream = CType(resources.GetObject("ImgListListViewS.ImageStream"), System.Windows.Forms.ImageListStreamer)
    Me.ImgListListViewS.TransparentColor = System.Drawing.Color.Transparent
    '
    'chkShowInGroup
    '
    Me.chkShowInGroup.Location = New System.Drawing.Point(12, 61)
    Me.chkShowInGroup.Name = "chkShowInGroup"
    Me.chkShowInGroup.Size = New System.Drawing.Size(159, 18)
    Me.chkShowInGroup.TabIndex = 45
    Me.chkShowInGroup.Text = "分组显示"
    '
    'tcboClientType
    '
    Me.tcboClientType.Location = New System.Drawing.Point(11, 36)
    Me.tcboClientType.Name = "tcboClientType"
    Me.tcboClientType.ReadOnly = True
    Me.tcboClientType.Size = New System.Drawing.Size(164, 20)
    Me.tcboClientType.TabIndex = 44
    Me.tcboClientType.Text = "TreeCombo1"
    Me.tcboClientType.TreeImageList = Me.ImgListTreeView
    '
    'ImgListTreeView
    '
    Me.ImgListTreeView.ImageSize = New System.Drawing.Size(16, 16)
    Me.ImgListTreeView.ImageStream = CType(resources.GetObject("ImgListTreeView.ImageStream"), System.Windows.Forms.ImageListStreamer)
    Me.ImgListTreeView.TransparentColor = System.Drawing.Color.Transparent
    '
    'labReceiveList
    '
    Me.labReceiveList.Anchor = CType((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
    Me.labReceiveList.AutoSize = True
    Me.labReceiveList.BackColor = System.Drawing.SystemColors.Control
    Me.labReceiveList.Cursor = System.Windows.Forms.Cursors.Default
    Me.labReceiveList.ForeColor = System.Drawing.SystemColors.ControlText
    Me.labReceiveList.Location = New System.Drawing.Point(11, 17)
    Me.labReceiveList.Name = "labReceiveList"
    Me.labReceiveList.RightToLeft = System.Windows.Forms.RightToLeft.No
    Me.labReceiveList.Size = New System.Drawing.Size(140, 17)
    Me.labReceiveList.TabIndex = 25
    Me.labReceiveList.Text = "请选择接收本信息的部门"
    '
    'frmSendEmail
    '
    Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
    Me.CancelButton = Me.cmdCancel
    Me.ClientSize = New System.Drawing.Size(722, 440)
    Me.Controls.Add(Me.grpInput)
    Me.Controls.Add(Me.grpDeptList)
    Me.Controls.Add(Me.pic)
    Me.Menu = Me.MainMenu1
    Me.Name = "frmSendEmail"
    Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
    Me.Text = "发送邮件"
    Me.pic.ResumeLayout(False)
    Me.grpInput.ResumeLayout(False)
    Me.panInput.ResumeLayout(False)
    Me.grpDeptList.ResumeLayout(False)
    Me.ResumeLayout(False)

  End Sub

#End Region


#Region "实用函数/过程"

  '选中所有的部门
  Private Sub CheckAllDepts()
    Dim i As Integer
    For i = 0 To tlvClient.Items.Count - 1
      tlvClient.Items(i).Checked = True
      tlvClient.Items(i).Selected = False
    Next i
  End Sub

  '发送邮件
  Private Function SendEmail() As String
    Dim clientObj As New clientMgrBusiness.Client
    Dim dmClient As New clientMgrBusiness.ClientDataModel
    Dim i As Integer
    Dim szResultMsg As String = ""
    Dim bResult As Boolean
    Dim tlvItem As TreeListViewItem
    Dim ErrMsg As String
    Dim thisMsg As String

    Dim ClientIdAry As New ArrayList

    '统计选中的客户数
    ClientIdAry.Clear()
    For i = 0 To tlvClient.CheckedItems.Length - 1
      tlvItem = tlvClient.CheckedItems(i)
      If tlvItem.SubItems.Count > 1 Then
        ClientIdAry.Add(tlvItem.Tag)
      End If
    Next

    szResultMsg = "共发送了[" & ClientIdAry.Count & "]封邮件,结果如下:" & vbLf
    For i = 0 To ClientIdAry.Count - 1
      Me.m_frmPmtObj.SetPromptMsg("正在发送第 " & (i + 1) & "/" & ClientIdAry.Count & " 封邮件")
      '给dmClient赋值 
      ErrMsg = clientObj.GetClientInfo(dmClient, ClientIdAry(i))
      bResult = Utility.EMail.SendMail(dmClient.Email, _
                                  txtTitle.Text, _
                                  Me.rtxtContent.Text, _
                                  , _
                                  txtSenderEmail.Text, _
                                  txtSenderEmail.Text, _
                                  m_AccountInfo.Pwd, _
                                  m_AccountInfo.SMTPServer)
      If bResult Then
        thisMsg = "发送成功!"
      Else
        thisMsg = "发送失败!"
      End If
      szResultMsg &= "邮件" & i & "To " & dmClient.Name & "(" & dmClient.Email & " ) :" & thisMsg & vbLf
    Next i


    Return szResultMsg

  End Function

  Private Sub UpdateList(ByVal iTypeId As Integer)
    Dim ErrMsg As String
    ErrMsg = mdlListView.ClientsToListView(tlvClient, iTypeId, chkShowInGroup.Checked, True, True)
    tlvClient.Columns(0).Width = -2
  End Sub


#End Region

#Region "收件部门列表相关事件响应"


  Private Sub cmdSelectedAll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
    CheckAllDepts()
  End Sub

  Private Sub cmdCancel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdCancel.Click
    Me.Close()
  End Sub

  '设置收件部门文本框的提示
  Private Sub cmdSelectedClear_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs)
    Dim i As Integer
    For i = 0 To tlvClient.Items.Count - 1
      tlvClient.Items(i).Checked = False
      tlvClient.Items(i).Selected = False
    Next i
  End Sub


  Private Sub tcboClientType_CloseDropDown(ByVal sender As Object, ByVal e As UtilityLibrary.Combos.CustomCombo.EventArgsCloseDropDown) Handles tcboClientType.CloseDropDown
    Dim iTypeId As Integer
    If Not tcboClientType.TreeDropDown.SelectedNode Is Nothing Then
      iTypeId = tcboClientType.TreeDropDown.SelectedNode.Tag
    Else
      iTypeId = 0
    End If
    UpdateList(iTypeId)
  End Sub

  Private Sub chkShowInGroup_CheckedChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles chkShowInGroup.CheckedChanged
    Dim iTypeId As Integer
    If Not tcboClientType.TreeDropDown.SelectedNode Is Nothing Then
      iTypeId = tcboClientType.TreeDropDown.SelectedNode.Tag
    Else
      iTypeId = 0
    End If
    UpdateList(iTypeId)
  End Sub

#End Region

  '初始化窗体
  Private Sub frmSendInfo_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
    Dim ErrMsg As String
    ErrMsg = mdlTreeView.TypesToTreeView(Me.tcboClientType.TreeDropDown, True)
    UpdateList(0)
    tcboClientType.SelectNodeByTag(0)
    tcboClientType.Text = "所有客户"
    tcboClientType.Value = "所有客户"
  End Sub

  Private Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
    Dim frm As New frmSmtpSetting
    frm.Account = txtSenderEmail.Text
    If frm.ShowDialog = DialogResult.OK Then
      m_AccountInfo.Account = frm.Account
      m_AccountInfo.Pwd = frm.Pwd
      m_AccountInfo.SMTPServer = frm.SMTPServer
      If txtSenderEmail.Text = "" Then
        txtSenderEmail.Text = m_AccountInfo.Account
      End If
    End If
  End Sub

#Region "菜单响应函数"

  Public Sub mnuReturn_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles mnuReturn.Click
    Me.Close()
  End Sub

  '发送信息,包括发送新信息,回复信息和发送广播
  '注意:发送菜单和发送铵钮的消息响应都在这个过程中
  Public Sub SendInfo_Click(ByVal eventSender As System.Object, _
                      ByVal eventArgs As System.EventArgs) _
                      Handles mnuSendInfo.Click, _
                              cmdSend.Click

    '检查信息填写是否完整
    If txtSenderEmail.Text = "" _
       Or txtTitle.Text = "" _
       Or rtxtContent.Text = "" Then
      MsgBox("请将每一项目都填写完整。", MsgBoxStyle.Information, Me.Text)
      Exit Sub
    End If

    '判断是否至少选择了一个接收部门
    If tlvClient.CheckedItems.Length < 1 Then
      MsgBox("请至少选择一个客户进行发送。", MsgBoxStyle.Information, "发送邮件")
      Exit Sub
    End If


    m_frmPmtObj.Show()
    System.Windows.Forms.Application.DoEvents()

    '发送信息
    Dim Errmsg As String
    Errmsg = Me.SendEmail()

    m_frmPmtObj.Close()
    MsgBox(Errmsg, MsgBoxStyle.Information, Me.Text)

    Me.Close()

  End Sub
#End Region


End Class

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?