Office中国论坛/Access中国论坛

标题: [求助]求access接收邮件的例子 [打印本页]

作者: liulubing 时间: 2006-10-29 15:46
标题: [求助]求access接收邮件的例子
各位版主,access发送的邮件的困难我已解决.现在又来了新的问题.就是怎么把outlook里个人文件夹中的资料收到数据库中来.不知那位有这方面的例子,请帮助一下.太难了,找了好多的资料都不行.只有求各位了.

作者: fan0217 时间: 2006-10-29 16:56
获取OutLook邮件，并写入Access数据表中：

Private Sub GetOutlookEmail()

Dim myolApp As Outlook.Application

Dim myNamespace As Outlook.NameSpace

Dim myFolder As Outlook.MAPIFolder

Dim <st1:place w:st="on"><st1:State w:st="on">Conn</st1:State></st1:place> As New ADODB.Connection

Dim Rec As New ADODB.Recordset

Dim stSql As String

Dim i As Integer

On Error GoTo GetOutlookEmail_Err

Set myolApp = CreateObject("Outlook.Application")          '创建Outlook应用程序对象

Set myNamespace = myolApp.GetNamespace("MAPI")             '获取MAPI命名域

Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)  '获取默认文件夹为收件箱

stSql = "SELECT * FROM tbl收件箱 "

Set Conn = CurrentProject.Connection  '建立连接为当前对象连接

Rec.Open stSql, Conn, adOpenKeyset, adLockPessimistic '建立并打开记录集

Do While Not Rec.EOF

      Rec.Delete  '删除原记录，以免重复

      Rec.Update

      Rec.MoveNext

<st1:place w:st="on">Loop</st1:place>

For i = 1 To myFolder.Items.Count

Rec.AddNew    '添加

      With myFolder.Items(i)

         Rec("未读") = .UnRead '未读标志

         Rec("发件人姓名") = .SenderName '发件人姓名

         Rec("发件人地址") = .SenderEmailAddress '发件人电子邮件地址

         'Rec("抄送") = nz(.CC)    '抄送

         'Rec("秘密抄送") = .BCC    '秘密抄送

         Rec("主题") = .Subject    '主题

         Rec("发送时间") = .LastModificationTime '发送日期和时间

         Rec("正文") = .Body       '正文

         Rec("大小") = .Size    '大小

         Rec("重要性") = .Importance    '重要性

      End With

Rec.Update  '保存

Next

Rec.Close

Set Rec = Nothing

<FONT face="Times New Roman"> <st1:place w:st="on"><st1:City w:st="on">Set</st1:City> <st1:State w:st="on">Conn</st1:State></st1:pl

作者: liulubing 时间: 2006-10-30 16:34
谢谢了.那附件怎么办.

[此贴子已经被作者于2006-10-30 8:36:19编辑过]

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)