form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX"
Begin VB.Form Form1 
   Caption         =   "可保存收件人地址的电子邮件发送器"
   ClientHeight    =   3135
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4665
   LinkTopic       =   "Form1"
   ScaleHeight     =   3135
   ScaleWidth      =   4665
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "保存收件人地址"
      Height          =   375
      Left            =   1755
      TabIndex        =   9
      Top             =   2745
      Width           =   1440
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   750
      TabIndex        =   8
      Top             =   15
      Width           =   3840
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退    出"
      Height          =   375
      Left            =   3210
      TabIndex        =   6
      Top             =   2745
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发    送"
      Height          =   375
      Left            =   480
      TabIndex        =   5
      Top             =   2745
      Width           =   1260
   End
   Begin VB.TextBox text1 
      Height          =   315
      Index           =   0
      Left            =   750
      TabIndex        =   4
      Top             =   345
      Width           =   3855
   End
   Begin VB.TextBox text1 
      Height          =   1695
      Index           =   1
      Left            =   735
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   675
      Width           =   3855
   End
   Begin MSMAPI.MAPISession MAPISession1 
      Left            =   -315
      Top             =   1785
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DownloadMail    =   -1  'True
      LogonUI         =   -1  'True
      NewSession      =   0   'False
   End
   Begin MSMAPI.MAPIMessages MAPIMessages1 
      Left            =   -285
      Top             =   2535
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      AddressEditFieldCount=   1
      AddressModifiable=   0   'False
      AddressResolveUI=   0   'False
      FetchSorted     =   0   'False
      FetchUnreadOnly =   0   'False
   End
   Begin VB.Label Label4 
      Height          =   360
      Left            =   630
      TabIndex        =   7
      Top             =   2385
      Width           =   4380
   End
   Begin VB.Label Label2 
      Caption         =   "主题："
      Height          =   255
      Left            =   90
      TabIndex        =   3
      Top             =   405
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "内容："
      Height          =   255
      Left            =   75
      TabIndex        =   1
      Top             =   705
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "收件人："
      Height          =   255
      Left            =   75
      TabIndex        =   0
      Top             =   45
      Width           =   735
   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    '建立一个邮件会话
  Set mydb = OpenDatabase(App.Path & "\myemail.mdb")   '设置保存邮件的数据库
  Set myrs = mydb.OpenRecordset("email", dbOpenTable)   '设置保存邮件的数据表
  myrs.MoveLast
  myrs.MoveFirst
  numcount = myrs.Fields.Count
  For i = 0 To myrs.RecordCount - 1
    Combo1.AddItem (myrs.Fields(0))    '增加邮件到下拉列表
    myrs.MoveNext
  Next i
  myrs.Close     '关闭数据表
  mydb.Close     '关闭数据表
End Sub
Private Sub Form_Activate()
   Combo1.SetFocus
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)  '移动焦点
  If KeyCode = vbKeyReturn Then
     text1(0).SetFocus
  End If
End Sub

Private Sub Command2_Click()   '保存邮件
  Set mydb = OpenDatabase(App.Path & "\myemail.mdb")
  Set myrs = mydb.OpenRecordset("email", dbOpenTable)
  myrs.AddNew
    myrs.Fields(0) = Combo1.Text
    myrs.Update
  myrs.Close
  mydb.Close
End Sub
Private Sub Command1_Click()   '发送邮件
  MAPIMessages1.MsgIndex = -1
  MAPIMessages1.RecipDisplayName = Combo1.Text
  MAPIMessages1.MsgSubject = text1(0).Text
  MAPIMessages1.MsgNoteText = text1(1).Text
  MAPIMessages1.SessionID = MAPISession1.SessionID
  MAPIMessages1.Send
  Label4.Caption = "发送邮件成功！"
End Sub
Private Sub text1_Change(Index As Integer)
  Label4.Caption = ""
End Sub

Private Sub text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)   '移动焦点
  Select Case Index
     Case 0
       If KeyCode = vbKeyReturn Then text1(1).SetFocus
       If KeyCode = vbKeyUp Then Combo1.SetFocus
     Case 1
       If KeyCode = vbKeyReturn Then Command1.SetFocus
       If KeyCode = vbKeyUp Then text1(0).SetFocus
  End Select
End Sub
Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next
  MAPISession1.SignOff
End Sub
Private Sub Command3_Click()
   End
End Sub