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 + -
显示快捷键?