在Outlook中用VBA导出HTML格式邮件
我每天所收到的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中，这样每个人都可以在网上浏览这些文章了。
