我每天所收到的e-mail中，订阅的电子杂志占了很大的比例。其中既有新闻也有电脑技术或娱乐性文章，加在一起竟有上百封。后来我知道单位里许多人同我一样也喜欢看，而且有的人还订了同样的杂志，所以我就每天收到邮件后把它们整理到局域网上去。只是这么多的邮件，整理起来工作量可不小，怎么解决一下呢？

　　 这些邮件通常都是HTML格式的，用Outlook通常的方法不能正确的导出，而且分布在许多下层子夹中，导出很麻烦。我在OUTLOOK中，用VBA实现了HTML邮件导出并自动发布到网络上。

　　 要对邮件箱里的邮件进行操作，首先要取得Outlook MAPI名字空间。可以使用下面的语句：

Dim mobjOutlook As Outlook.NameSpace
　　 Dim objOutlook As New Outlook.Application
　　 mobjOutlook=objoutlook.GetNameSpace(“MAPI”)

　　 用mobjOutlook的GetDefaultFolder方法。可以取得收件箱的MAPIFolder对象：

Dim objFolder As Outlook.MAPIFolder
　　 ObjFolder=mobjOutlook.GetDefaultFolder(6)

　　 其中参数6代表收件箱，其他参数的意义如下表：

常量

数值

描述

　　 OlFolderDeletedItems

3

已删除邮件

OlFolderOutbox

4

发件箱

OlFolderSentMail

5

已发件邮件

olFolderInbox

6

收件箱

OlFolderCalendar

9

日历

OlFolderContacts

10

联系人

olFolderJournal

11

日记

olFolderNotes

12

便笺

olFolderTasks

13

任务

olFolderDrafts

16

草稿

　　 在objFolder的属性包含邮件项集合即ITEMS，也包含所有下一级子夹的集合Folders。

　　 对每一个邮件，首先取得邮件的接收时间，如果是当天收到的就创建并打开一个HTML文件，以其主题Subject为文件名，把它的HTML格式的内容，即HTMLBody属性的值写入这个文件，然后关闭并处理下一个。

　　 对下一级子夹，用递归调用的方式，可以遍历收件箱中每一层夹中的所有邮件。在生成邮件文件时，还同时生成索引文件。

完整的程序如下：

　　

Private mobjOutlook As Outlook.NameSpace
　　 Private fs, fo
　　 Private Sub GetOutlook()
　　 Dim objOutlook As New Outlook.Application
　　 Set mobjOutlook = objOutlook.GetNamespace("MAPI")
　　 End Sub
　　 Sub ListMailFolders(objFolder As Outlook.MAPIFolder)
　　 Dim objItem As Object
　　 Dim f
　　 Dim str1, str2, str3 As String
　　 For Each objItem In objFolder.Items
　　 If (FormatDateTime(objItem.ReceivedTime, vbShortDate) = FormatDateTime(Date, vbShortDate)) Then
　　 str2 = objItem.Subject
　　 str1 = "j:wwwrootnews" + str2 + ".htm"
　　 Set f = fs.OpenTextFile(str1, 2, True, TristateFalse)
　　 f.Write objItem.HTMLBody
　　 f.Close
　　 str3 = "< p>< a href='" + objItem.Subject + ".htm'>" + objItem.Subject + "< /a>< /p> "
　　 fo.Write str3
　　 End If
　　 Next
　　 Dim objf As Outlook.MAPIFolder
　　 For Each objf In objFolder.Folders
　　 ListMailFolders objf
　　 Next
　　 Set objItem = Nothing
　　 End Sub
　　 Sub ListMailItems(longFolder As Long)
　　 Dim objFolder As Outlook.MAPIFolder
　　 Dim f
　　 If mobjOutlook Is Nothing Then
　　 GetOutlook
　　 End IF
　　 Set objFolder = mobjOutlook.GetDefaultFolder(longFolder)
　　 ListMailFolders objFolder
　　 End Sub
　　 Private Sub storemail()
　　 Set fs=CreateObject(“Scripting.FileSystemObject”)
　　 Set fo=fs.OpenTextFile(“j:wwwrootnewsindex.html”,2,True,TristateFalse)
　　 fo.Write “< HTML>< HEAD>< META content=’text/html; charset=gb2312’ http-equiv=Content-Type> < TITLE>< /TITLE>< /HEAD>< BODY>
　　 ListMailItems(6)
　　 fo.Write “< /BODY>< /HTML>”
　　 fo.Close
　　 End Sub

　　 在Outlook2000中创建一个新的宏，用VB编辑器编辑它，把上面的程序拷贝到同一模块，注意把生成文件的目录名改为自己WEB服务器上的WWW服务根文件夹名。在宏中调用storemail，执行宏，就可以导出当天收到的所有邮件。

　　 所有指向这些HTML文件的链接放在同一目录下的index.html中，这样每个人都可以在网上浏览这些文章了。