使用VBA从Excel中提取Outlook邮件正文文本 [英] Extract outlook message body text with VBA from Excel

问题描述

我将大量Outlook .msg和Outlook .eml文件保存到共享的网络文件夹(即Outlook外部)中.我正在尝试在Excel中编写一些VBA，以从每个文件中提取主题，发件人，抄送，接收方，SentTime，SentDate，邮件正文文本，并将这些信息有序地导入Excel单元格中

I have a huge number of Outlook .msg and Outlook .eml files saved to a shared network folder (ie outside of Outlook). I am trying to write some VBA in Excel that extracts the Subjects，Sender, CC, Receiver, SentTime, SentDate, message body text from each file and import these info to Excel cells orderly

主题发件人CC接收方的SentTime SentDate

Subject Sender CC Receiver SentTime SentDate

Re:.. Mike Jane Tom 2013年1月23日12:00:00

Re:.. Mike Jane Tom 12:00:00 23 Jan 2013

我对Word文档也做过类似的事情，但是我正在努力获取" .msg文件中的文本.

I've done a similar thing with word documents but I'm struggling to 'get at' the text in the .msg files.

到目前为止，我有下面的代码.我想至少应该走在正确的道路上，但是我被困在试图建立对msg文件的引用的行上.任何建议将不胜感激...

So far I have the code below. I like to think I'm on the right track at least, but I'm stuck at the line where I'm trying to set up a reference to the msg file. Any advice will be appreciated...

Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem

Set MyOutlook = New Outlook.Application


Set MyMail = 

Dim FileContents As String

FileContents = MyMail.Body

致谢

推荐答案

，因此我能够将其与Outlook外部保存的.msg文件一起使用.但是，由于我无权访问Outlook Express，因此目前无法保存任何.eml文件.这是我想出的一个Sub，它将Subject，Sender，CC，To和SendOn插入到Excel工作表中，该工作表从第2行第1列开始(假设在第1行有标题行):

so I've been able to get it working with .msg files saved outside of outlook. However, as I don't have access to Outlook Express I have no way of saving any .eml files at the moment. Here's a Sub I've come up with that will insert Subject,Sender,CC,To, and SendOn into an excel worksheet starting at row 2 column 1 (assuming a header row at row 1):

Sub GetMailInfo(Path As String)

    Dim MyOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim x As Namespace

    Set MyOutlook = New Outlook.Application
    Set x = MyOutlook.GetNamespace("MAPI")

    FileList = GetFileList(Path + "*.msg")


    row = 1

    While row <= UBound(FileList)

        Set msg = x.OpenSharedItem(Path + FileList(row))

        Cells(row + 1, 1) = msg.Subject
        Cells(row + 1, 2) = msg.Sender
        Cells(row + 1, 3) = msg.CC
        Cells(row + 1, 4) = msg.To
        Cells(row + 1, 5) = msg.SentOn


        row = row + 1
    Wend

End Sub

使用下面定义的GetFileList函数(感谢 spreadsheetpage.com )

which uses the GetFileList function as defined below (thanks to spreadsheetpage.com)

Function GetFileList(FileSpec As String) As Variant
'   Taken from http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
    NoFilesFound:
        GetFileList = False
End Function

应该很简单，如果您需要更多说明，请告诉我.

Should be fairly straightforward, let me know if you need any more explanation.

您还必须添加对Outlook库的引用

You'll also have to add a reference to the outlook library

HTH！

Z

这篇关于使用VBA从Excel中提取Outlook邮件正文文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！