📄 form1.frm
字号:
VERSION 5.00
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX"
Begin VB.Form Form1
Caption = "邮件数据管理程序-保存"
ClientHeight = 5325
ClientLeft = 60
ClientTop = 345
ClientWidth = 6780
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 5325
ScaleWidth = 6780
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton Command2
Caption = "查看"
Height = 375
Left = 4140
TabIndex = 14
Top = 4845
Width = 1200
End
Begin VB.CommandButton Command1
Caption = "保存"
Height = 375
Left = 2940
TabIndex = 13
Top = 4845
Width = 1200
End
Begin VB.CheckBox Check1
Caption = "包含已读信件"
Height = 345
Left = 510
TabIndex = 11
Top = 4830
Value = 1 'Checked
Width = 2385
End
Begin VB.ListBox List1
Height = 960
Left = 510
TabIndex = 10
Top = 420
Width = 6015
End
Begin VB.CommandButton command3
Caption = "退出"
Height = 375
Left = 5340
TabIndex = 8
Top = 4845
Width = 1200
End
Begin VB.TextBox text1
Height = 375
Index = 0
Left = 1380
TabIndex = 6
Top = 1500
Width = 5145
End
Begin MSMAPI.MAPIMessages MAPIMessages1
Left = -150
Top = 270
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
AddressEditFieldCount= 1
AddressModifiable= 0 'False
AddressResolveUI= 0 'False
FetchSorted = 0 'False
FetchUnreadOnly = 0 'False
End
Begin MSMAPI.MAPISession MAPISession1
Left = -165
Top = 1005
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DownloadMail = -1 'True
LogonUI = -1 'True
NewSession = 0 'False
End
Begin VB.TextBox text1
Height = 1995
Index = 2
Left = 480
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 5
Top = 2760
Width = 6045
End
Begin VB.TextBox text1
Height = 375
Index = 1
Left = 1365
TabIndex = 4
Top = 1950
Width = 2475
End
Begin VB.TextBox text1
Height = 375
Index = 3
Left = 4515
TabIndex = 3
Top = 1965
Width = 1995
End
Begin VB.Label Label1
Caption = "邮件列表"
Height = 285
Index = 4
Left = 540
TabIndex = 12
Top = 210
Width = 2205
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "总计 0 封邮件"
Height = 255
Index = 3
Left = 3180
TabIndex = 9
Top = 180
Width = 3345
End
Begin VB.Label Label1
Caption = "主题："
Height = 255
Index = 0
Left = 555
TabIndex = 7
Top = 1560
Width = 615
End
Begin VB.Label Label2
Caption = "内容："
Height = 255
Left = 525
TabIndex = 2
Top = 2430
Width = 855
End
Begin VB.Label Label1
Caption = "发件人："
Height = 255
Index = 1
Left = 510
TabIndex = 1
Top = 1995
Width = 855
End
Begin VB.Label Label1
Caption = "日期："
Height = 210
Index = 2
Left = 3915
TabIndex = 0
Top = 2115
Width = 645
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mydb As Database
Dim myrs As Recordset
Private Sub Form_Load()
On Error Resume Next
MAPISession1.SignOn '打开会话
MAPIMessages1.SessionID = MAPISession1.SessionID
For i = 0 To MAPIMessages1.MsgCount - 1
MAPIMessages1.MsgIndex = i
List1.AddItem MAPIMessages1.MsgSubject '添加邮件
Next i
List1.ListIndex = 0
MAPIMessages1.MsgIndex = 0
text1(0).Text = MAPIMessages1.MsgSubject '显示邮件主题
text1(1).Text = MAPIMessages1.MsgOrigDisplayName '显示邮件收件人
text1(2).Text = MAPIMessages1.MsgNoteText '显示邮件内容
text1(4).Text = MAPIMessages1.MsgDateReceived '显示邮件日期
Label1(3).Caption = "信箱共有未读邮件：" & MAPIMessages1.MsgCount & " 封 。"
End Sub
Private Sub Check1_Click()
If MAPIMessages1.FetchUnreadOnly = True Then '包含所有邮件
MAPIMessages1.FetchUnreadOnly = False
MAPIMessages1.Fetch
Label1(3).Caption = "信箱共有邮件：" & MAPIMessages1.MsgCount & " 封 。 "
Else
MAPIMessages1.FetchUnreadOnly = True '只包含未读邮件
MAPIMessages1.Fetch
Label1(3).Caption = "信箱共有未读邮件：" & MAPIMessages1.MsgCount & " 封 。"
End If
For i = 0 To MAPIMessages1.MsgCount - 1
MAPIMessages1.MsgIndex = i
List1.AddItem MAPIMessages1.MsgSubject '添加邮件主题到列表
Next i
End Sub
Private Sub List1_Click() '选择邮件
MAPIMessages1.MsgIndex = List1.ListIndex '到指定邮件
text1(0).Text = MAPIMessages1.MsgSubject '显示邮件主题
text1(1).Text = MAPIMessages1.MsgOrigDisplayName '显示邮件收件人
text1(2).Text = MAPIMessages1.MsgNoteText '显示邮件内容
text1(3).Text = MAPIMessages1.MsgDateReceived '显示邮件日期
End Sub
Private Sub command1_Click() '保存邮件到数据库
Set mydb = OpenDatabase(App.Path & "\email.mdb") '打开指定的数据库
Set myrs = mydb.OpenRecordset("email", dbOpenTable) '打开指定数据表
myrs.AddNew '保存邮件数据
myrs.Fields("主题") = text1(0).Text
myrs.Fields("发件人") = text1(1).Text
myrs.Fields("内容") = text1(2).Text
myrs.Fields("日期") = Date
myrs.Fields("时间") = Time
myrs.Fields("收发类型") = "接收邮件"
myrs.Update
myrs.Close
mydb.Close
End Sub
Private Sub Command2_Click()
Load Form2
Form2.Show
Unload Me
End Sub
Private Sub command3_Click()
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -