📄 sendmail.frm
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmsend
BackColor = &H80000009&
Caption = "写邮件"
ClientHeight = 5070
ClientLeft = 60
ClientTop = 345
ClientWidth = 7065
FillColor = &H80000016&
Icon = "sendmail.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 5070
ScaleWidth = 7065
StartUpPosition = 2 '屏幕中心
Begin VB.ComboBox Cmbfirst
Height = 300
ItemData = "sendmail.frx":0442
Left = 6000
List = "sendmail.frx":044F
Style = 2 'Dropdown List
TabIndex = 22
Top = 1680
Width = 855
End
Begin VB.PictureBox picdemo
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
ForeColor = &H80000008&
Height = 735
Left = 1800
ScaleHeight = 705
ScaleWidth = 3345
TabIndex = 20
Top = 2160
Visible = 0 'False
Width = 3375
Begin VB.Image Image5
Height = 570
Left = -360
Picture = "sendmail.frx":0465
Top = 41
Width = 1140
End
Begin VB.Label Label14
BackStyle = 0 'Transparent
Caption = "邮件发送中,请稍候......"
Height = 255
Left = 960
TabIndex = 21
Top = 280
Width = 2295
End
End
Begin VB.CommandButton Command1
Caption = "选择附件"
Height = 300
Left = 5880
TabIndex = 17
Top = 2400
Width = 975
End
Begin VB.ListBox txtatt
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
ItemData = "sendmail.frx":1DDD
Left = 1320
List = "sendmail.frx":1DDF
TabIndex = 15
Top = 2450
Width = 4455
End
Begin VB.TextBox txtsubject
Appearance = 0 'Flat
Height = 300
Left = 1320
TabIndex = 14
Top = 2040
Width = 5535
End
Begin VB.TextBox txtrecc
Appearance = 0 'Flat
Height = 300
Left = 1320
TabIndex = 13
Top = 1680
Width = 3615
End
Begin VB.TextBox txtreto
Appearance = 0 'Flat
Height = 300
Left = 1320
TabIndex = 12
Top = 1320
Width = 5535
End
Begin VB.TextBox txtto
Appearance = 0 'Flat
Height = 300
Left = 1320
TabIndex = 11
Top = 960
Width = 5535
End
Begin VB.TextBox txtfrom
Appearance = 0 'Flat
Height = 300
Left = 1320
Locked = -1 'True
TabIndex = 10
Top = 600
Width = 5535
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000006&
ForeColor = &H80000008&
Height = 495
Left = 120
ScaleHeight = 465
ScaleWidth = 6705
TabIndex = 1
Top = 0
Width = 6735
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "PKPM网络办公电子邮件系统"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 180
Left = 120
TabIndex = 3
Top = 120
Width = 2370
End
Begin VB.Label lblsubject
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "--[无标题]"
ForeColor = &H8000000E&
Height = 180
Left = 2520
TabIndex = 2
Top = 120
Width = 900
End
End
Begin MSComDlg.CommonDialog attdlg
Left = 5400
Top = 3600
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DefaultExt = "*.*"
DialogTitle = "选择附件"
Filter = "(*.*)"
End
Begin RichTextLib.RichTextBox rbody
Height = 1575
Left = 360
TabIndex = 0
Top = 2880
Width = 6375
_ExtentX = 11245
_ExtentY = 2778
_Version = 393217
BorderStyle = 0
Enabled = -1 'True
ScrollBars = 2
Appearance = 0
TextRTF = $"sendmail.frx":1DE1
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "发送邮件"
Height = 180
Left = 5880
MouseIcon = "sendmail.frx":1E7E
MousePointer = 99 'Custom
TabIndex = 19
Top = 4740
Width = 720
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "取消发送"
Height = 180
Left = 4560
MouseIcon = "sendmail.frx":2188
MousePointer = 99 'Custom
TabIndex = 18
Top = 4740
Width = 720
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "邮件优先级"
ForeColor = &H000000FF&
Height = 180
Left = 5000
TabIndex = 16
Top = 1725
Width = 900
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "标 题"
Height = 180
Left = 480
TabIndex = 9
Top = 2100
Width = 540
End
Begin VB.Shape Shape7
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 2040
Width = 975
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "附 件"
Height = 180
Left = 480
TabIndex = 8
Top = 2460
Width = 540
End
Begin VB.Shape Shape6
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 2400
Width = 975
End
Begin VB.Shape Shape1
BorderColor = &H8000000C&
Height = 300
Left = 240
Top = 600
Width = 975
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "发件人"
Height = 180
Left = 480
TabIndex = 7
Top = 660
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "收件人"
Height = 180
Left = 480
MouseIcon = "sendmail.frx":2492
MousePointer = 99 'Custom
TabIndex = 6
Top = 1020
Width = 540
End
Begin VB.Shape Shape2
BackColor = &H80000003&
BorderColor = &H8000000C&
FillColor = &H80000013&
FillStyle = 0 'Solid
Height = 300
Left = 240
Top = 960
Width = 975
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "抄 送"
Height = 180
Left = 480
MouseIcon = "sendmail.frx":279C
MousePointer = 99 'Custom
TabIndex = 5
Top = 1380
Width = 540
End
Begin VB.Shape Shape3
BorderColor = &H8000000C&
FillColor = &H80000013&
FillStyle = 0 'Solid
Height = 300
Left = 240
Top = 1320
Width = 975
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密 送"
Height = 180
Left = 480
MouseIcon = "sendmail.frx":2AA6
MousePointer = 99 'Custom
TabIndex = 4
Top = 1740
Width = 540
End
Begin VB.Shape Shape4
BorderColor = &H8000000C&
FillColor = &H8000000B&
FillStyle = 0 'Solid
Height = 300
Left = 240
Top = 1680
Width = 975
End
Begin VB.Shape Shape5
BorderColor = &H8000000C&
Height = 1740
Left = 240
Top = 2760
Width = 6615
End
Begin VB.Shape Shape8
BackColor = &H00E0E0E0&
BackStyle = 1 'Opaque
BorderColor = &H8000000C&
Height = 300
Left = 4320
Top = 4680
Width = 1215
End
Begin VB.Shape Shape9
BackColor = &H00E0E0E0&
BackStyle = 1 'Opaque
BorderColor = &H8000000C&
Height = 300
Left = 5640
Top = 4680
Width = 1215
End
End
Attribute VB_Name = "frmsend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public smtpuser As String
Public smtppass As String
Public smtpserver As String
Public EmailAddress As String
Public clickone As String
Dim contentid As String
Public smtp As New jmail.Message
Private Sub Command1_Click()
attdlg.ShowOpen
If attdlg.FileName <> "" Then
txtatt.AddItem attdlg.FileName
contentid = smtp.AddAttachment(attdlg.FileName, True)
End If
End Sub
Private Sub Form_Load()
Cmbfirst.ListIndex = 0
End Sub
Private Sub Label10_Click()
Dim rec() As String
Dim subrec As Variant
Dim i As Integer
On Error GoTo Label1
If txtto.Text = "" Then
MsgBox "请先填写收件人地址!", vbInformation + vbOKOnly, "注意"
Exit Sub
End If
picdemo.Visible = True
DoEvents
smtp.Charset = "gb2312"
smtp.From = txtfrom.Text
smtp.Subject = txtsubject.Text
smtp.MailServerUserName = Me.smtpuser
smtp.MailServerPassWord = Me.smtppass
smtp.Priority = 3
rec = Split(txtto.Text, ",", -1, 1)
For Each subrec In rec
smtp.AddRecipient subrec
Next subrec
rec = Split(txtreto.Text, ",", -1, 1)
For Each subrec In rec
smtp.AddRecipientCC subrec
Next subrec
rec = Split(txtrecc.Text, ",", -1, 1)
For Each subrec In rec
smtp.AddRecipientBCC subrec
Next subrec
'If txtatt.ListCount > 0 Then
'For i = 0 To txtatt.ListCount - 1
' contentid = smtp.AddAttachment(txtatt.List(i), True)
'Next i
'End If
smtp.Body = rbody.Text
If Cmbfirst.ListIndex = 0 Then
smtp.Priority = 3
ElseIf Cmbfirst.ListIndex = 1 Then
smtp.Priority = 1
ElseIf Cmbfirst.ListIndex = 2 Then
smtp.Priority = 5
End If
smtp.Send Me.smtpserver
smtp.Close
Set smtp = Nothing
picdemo.Visible = False
Exit Sub
Label1:
picdemo.Visible = False
MsgBox Err.Description
End Sub
Private Sub Label4_Click()
clickone = "shou"
frmcontact.Show 1
End Sub
Private Sub Label5_Click()
clickone = "chao"
frmcontact.Show 1
End Sub
Private Sub Label6_Click()
clickone = "mi"
frmcontact.Show 1
End Sub
Private Sub Label9_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -