在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中，這樣每個人都可以在網上瀏覽這些文章了。