vb制作邮箱收信程序

vb制作一个邮箱收信程序
按一个键就把text1内容自动由111@163.com(111@163.com密码是111111)发送到222@163.com,邮箱标题是:客服建议
我要类似于下面的运用方法:
Private Function SendEMail(ByVal mFrom As String, _

On Error GoTo Fail
Dim Email As Object, NameS As String
NameS = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = mFrom
Email.To = mTo
Email.Subject = mTitle
Email.Textbody = mText
Email.Configuration.Fields.Item(NameS & "sendusing") = 2
Email.Configuration.Fields.Item(NameS & "smtpserver") = mSmtp
Email.Configuration.Fields.Item(NameS & "smtpserverport") = 25
Email.Configuration.Fields.Item(NameS & "smtpauthenticate") = 1
Email.Configuration.Fields.Item(NameS & "sendusername") = mUserName
Email.Configuration.Fields.Item(NameS & "sendpassword") = mPassWord
Email.Configuration.Fields.Update
Email.Send
SendEMail = True
Exit Function
Fail:
End Function

我只有ACCESS的VBA代码供你参考，vba与vb很多代码是可以共用的，你不妨参与研究下：

ACCESS发送邮件代码

access 2009-02-11 16:41 阅读23 评论0 字号： 大大 中中 小小 Private Sub Command1_Click() '发送邮件，依据ACCESS开发答疑200问P226页
'首先，确保已经安装了OutLook,然后在引用中引用Microsoft OutLook对象，在输入以下代码就可实现创建一个新邮件，并添加一个附件到邮件中，然后发送邮件的功能。
'通过引用OutLook.Application对象，Access可以循环OutLook对象里面的所有内容，例如可以读取OutLook里的所有邮件、联系人、约会、日记等信息，还可修改OutLook内置的“规则精灵”
'的内容。
Dim myOlApp As Object
Dim myNamespace As Object

Set myOlApp = CreateObject("OutLook.Application") '创建OutLook应用程序对象
Set myNamespace = myOlApp.getNamespace("MAPI") '获取MAPI命名空间
Set myFolder = myNamespace.getDefaultFolder(6) '获取默认的文件夹
Set myitem = myOlApp.CreateItem(0) '创建新邮件

myitem.Display
Set myRecipient = myitem.Recipients.Add("rcylbx@21cn.com") '为邮件添加收件人
myRecipient.Type = 1
myitem.Subject = "test" '设置邮件主题
MsgBox "ok"
myitem.Attachments.Add ("d:\test.txt") '添加邮件附件，注意确保硬盘下有这个文件
myitem.Save
myitem.Send
MsgBox "ok"
End Sub

Private Sub Command2_Click()
'代码说明:
'本代码可以在安装了outlook（2000以上版本的）的机器上运行。不过outlook xp 以上
'的版本由于出于防止邮件病毒的目的，对发送邮件进行监控，运用本程序每发送一封
'email都需要用户确认，会有点麻烦，但是还是出于安全的角度考虑。

'可以将这段代码嵌入access的模块?excel的宏中运行?

'程序要求:

'需要引用 "microsoft outlook x.x library"

'代码:
Dim olkapp As Outlook.Application '在使用outlook之前必须先声明outlook应用程序的对象，应用程序
Dim newmail As MailItem '在使用outlook之前必须先声明outlook应用程序的对象，邮件项目对象
Dim emailadd, para As String

Set olkapp = CreateObject("outlook.application") '指定outlook应用程序的实体变量
Set newmail = olkapp.CreateItem(olMailItem) '指定邮件项目的实体变量

'邮件正文内容
para = para + "祝新春快乐，并友情提醒注意新的邮件病毒。"

'收件人的email地址，这里没有输入内容。
emailadd = "rcylbx@21cn.com"

With newmail

.To = emailadd '发送邮件地址
.Subject = "新春快乐" ' 邮件的主题
.Importance = olImportanceHigh '邮件的为重要等级
.Body = para '将邮件正文内容指定para变量内容

'.Send '发送
.Display '启动视窗
End With

On Error GoTo continue
SendEmail:
newmail.Display
DoEvents
SendKeys "%s", Wait:=True
DoEvents
AppActivate newmail
GoTo SendEmail '发送不成功誓不罢休
continue:
On Error GoTo 0
Set olkapp = Nothing
Set newmail = Nothing

End Sub

Sub email_send()

Dim olkapp As Outlook.Application
Dim newmail As MailItem
Dim emailadd, para As String

Set olkapp = CreateObject("outlook.application")
Set newmail = olkapp.CreateItem(olMailItem)

'邮件正文内容
para = para + "祝新春快乐，并友情提醒注意新的邮件病毒。"

'收件人的email地址，这里没有输入内容。
emailadd = ""

With newmail

.To = emailadd
.Subject = "新春快乐" ' 邮件的主题
.Importance = olImportanceHigh '邮件的为重要等级
.Body = para '将邮件正文内容指定para变量内容

.Send '发送

End With

End Sub

Private Sub Command3_Click()
'方法一是用代码模拟发送邮件确认 (代码引用论坛前辈的代码)

Dim objOL As Object
Dim itmNewMail As Object
'引用Microsoft Outlook 物件模型
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)

With itmNewMail
.Subject = "chijanzen Mail Test" '主旨
.Body = "发送邮件测试2222" '本文
.To = "rcylbx@21cnl.com" '收件者
.Attachments.Add "d:\test.txt", olByValue, 1, "4th Quarter 1996 Results Chart"
.Display '启动视窗
End With
On Error GoTo continue
SendEmail:
AppActivate itmNewMail
DoEvents
SendKeys "%s", Wait:=True
DoEvents
AppActivate itmNewMail
GoTo SendEmail '发送不成功誓不罢休
continue:
On Error GoTo 0
Set objOL = Nothing
Set itmNewMail = Nothing

'再次测试中发现，窗口标题为中文时，AppActivate命令不能执行。将AppActivate命令改为Display方法，可解决此问题，即将AppActivate itmNewMail改为itmNewMail.display。

End Sub
'方法一是用代码模拟发送邮件确认 (代码引用论坛前辈的代码)

Sub SendMail()
Dim objOL As Object
Dim itmNewMail As Object
'引用Microsoft Outlook 物件模型
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)

With itmNewMail
.Subject = "chijanzen Mail Test" '主旨
.Body = Application.UserName & "发送邮件测试2222" '本文
.To = "171262953@qq.com" '收件者
.Attachments.Add "C:\PDOS.DEF", olByValue, 1, "4th Quarter 1996 Results Chart"
.Display '启动视窗
End With
On Error GoTo continue
SendEmail:
AppActivate itmNewMail
DoEvents
SendKeys "%s", Wait:=True
DoEvents
AppActivate itmNewMail
GoTo SendEmail '发送不成功誓不罢休
continue:
On Error GoTo 0
Set objOL = Nothing
Set itmNewMail = Nothing
End Sub
'再次测试中发现，窗口标题为中文时，AppActivate命令不能执行。将AppActivate命令改为Display方法，可解决此问题，即将AppActivate itmNewMail改为itmNewMail.display。
**************************************

***************************************
Sub Send_Order_Mail()

Dim cnn As ADODB.Connection
Dim rst_cusid, rst_order_list As ADODB.Recordset

Dim olkapp As Outlook.Application
Dim newmail As MailItem

Set olkapp = CreateObject("outlook.application")

Set cnn = New ADODB.Connection
cnn.Open CurrentProject.Connection

Set rst_cusid = New ADODB.Recordset
rst_cusid.Open "select distinct CustomerID,CompanyName,Email from v_order_list", cnn, adOpenKeyset, adLockReadOnly

If rst_cusid.RecordCount < 1 Then Exit Sub

Set rst_order_list = New ADODB.Recordset

For i = 1 To rst_cusid.RecordCount

rst_order_list.Open "select * from v_order_list where CustomerID = " + "'" + rst_cusid.Fields(0) + "'", cnn, adOpenKeyset, adLockReadOnly

With rst_order_list
para = "Dear " + .Fields(1) + ":" + Chr(10)

para = para + Space(3) + "Your Company " + .Fields(0) + " has Order those Good:" + Chr(10)

For j = 1 To .RecordCount

para = para + Space(3) + "Good Name :" + .Fields(2) + " Order Date :" + CStr(.Fields(3)) + " Price:" + CStr(.Fields(4)) + Chr(10)

Next

End With

rst_order_list.Close

para = para + Space(30) + "Yours Loadhigh" 'para为信件内容

Set newmail = olkapp.CreateItem(olMailItem)

With newmail

.To = rst_cusid.Fields(2) '接收邮件的信箱
.Subject = rst_cusid.Fields(1) + " Order List" '信件标题
.Body = para
.Send '发送
End With

rst_cusid.MoveNext

para = ""
Next

rst_cusid.Close

Set rst_cusid = Nothing
Set rst_order_list = Nothing

cnn.Close

Set cnn = Nothing

End Sub
***********************************************************
Function test1()
Dim objMail As MailItem
Dim objAttachments As Attachment
Dim App As New Outlook.Application

Set objMail = App.CreateItem(olMailItem)
objMail.Save
Set objAttachments = objMail.Attachments.Add("c:\temp\a.xls", olByValue, 1, "a.xls")
With objMail
.To = "chenge@shtip.com.cn" '接收邮件的信箱
.Subject = "test" '信件标题
.Body = "test"
.Send '发送
End With
'objMail.Display
End Function
*********************************************************

VBScript code
Set Msg =
CreateObject("CDO.Message")
With Msg
.To = "someone@microsoft.com"
.From = "userX@microsoft.com"
.Subject = "Lunch meeting"
.TextBody = "I have attached the suggested menu."
.AddAttachment "file://c:/menu.doc"
.Send
End With

另，若因发垃圾邮件被163.com封账号，可以联系客服解释是电脑中了病毒。

我也在写这个东西。在网上找了很久，没有找到好用的代码 都太老了，不过如果你没有附件直接用 MAPI 就可以了

收信？？我下过不少代码，好像都没实现，我自己也没做出来过，只做过用利用udp协议实现通讯的。