代码之家 › 专栏 › 技术社区 › Craig

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

flat-file outlook-vba outlook email vba

5

Craig · 技术社区 · 15 年前

我已经编写了一个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”。由于我不太关心这个阶段的性能,所以对于这个示例来说,非常低效的“open,append,close”文件方法很好。

我知道我可以花一些时间在谷歌上查找答案,但我先在这里查了一下,没有好的答案。作为Stackoverflow的粉丝,我希望把它放在这里能帮助未来的开发者寻找答案。谢谢你的耐心。

3 回复 | 直到 4 年前

1

6

Jon Fournier 15 年前

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

2

4

Eric Ness 15 年前

如果您不介意每次添加一些文本时都重新打开输出文件,那么这应该是可行的。

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。

3

1

jim 13 年前

您还必须注意安全弹出窗口“尝试访问电子邮件地址”,该窗口包含在 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