使用VBA将电子邮件信息写入Outlook中的平面文件

Question

我已经编写了一个VBA应用程序，它在Outlook中打开一个文件夹，然后遍历消息。我需要将消息体（通过一些调整）写入单个平面文件。我的代码如下...

Private Sub btnGo_Click() 
    Dim objOutlook As New Outlook.Application 
    Dim objNameSpace As Outlook.NameSpace 
    Dim objInbox As MAPIFolder 
    Dim objMail As mailItem 
    Dim count As Integer 

    Set objNameSpace = objOutlook.GetNamespace("MAPI") 
    Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox) 
    count = 0 

    For Each objMail In objInbox.Items 
     lblStatus.Caption = "Count: " + CStr(count) 
     ProcessMailItem (objMail) 
     count = count + 1 
    Next objMail 

    End If 
End Sub 

问题的部分是“ProcessMailItem”。由于我在这个阶段并不过分关注性能，所以对于这个例子来说，非常不合适的“开放，追加，关闭”文件方法是很好的。

我知道我可以花一些时间用谷歌查找答案，但我先在这里查了一下，没有很好的答案。作为Stackoverflow的忠实粉丝，我希望能够在这里提供帮助，帮助未来的开发者寻找答案。谢谢你的耐心。

Answer 1

您可以写入文件，而无需使用任何对象，只需使用内置的VBA文件的工具脱身：

Open "C:\file.txt" for append as 1 
Print #1, SomeStringVar 
Close #1 

Answer 2

如果你不介意每次追加文本时重新打开输出文件，那么这应该工作。

Private Sub ProcessMailItem(objMail As MailItem) 

    Dim fso As New FileSystemObject 
    Dim ts As TextStream 

    Set ts = fso.OpenTextFile("C:\Outputfile.txt", ForAppending, True) 

    ts.Write(objMail.Body) 

    ts.Close() 
    Set ts = Nothing 
    Set fso = Nothing 

End Sub 

您还需要添加对Microsoft脚本运行时库的引用。这里有FileSystemObject。

Answer 3

你也必须采取安全弹出的关怀“试图访问电子邮件地址“这是覆盖在Outlook "Object Model Guard" Security Issues for Developers

Public Sub ProcessMailItem(objMail As MailItem) 
Dim FSO As New FileSystemObject 
Dim ts As TextStream 
Dim loc As String 
Dim subject As String 
Dim strID As String 
' per http://www.outlookcode.com/article.aspx?ID=52 
Dim olNS As Outlook.NameSpace 
Dim oMail As Outlook.MailItem 

strID = MyMail.EntryID 
Set olNS = Application.GetNamespace("MAPI") 
Set oMail = olNS.GetItemFromID(strID) 
subject = oMail.subject 
Set ts = FSO.OpenTextFile("C:\Documents and Settings\tempuser\My Documents\EMAILS\" + subject, ForAppending, True) 
ts.Write (oMail.Body) 
ts.Close 
Set ts = Nothing 
Set FSO = Nothing 
Set oMail = Nothing 
Set olNS = Nothing 

末次