在vba excel中解析eml文件的主体

时间:2016-02-23 21:20:39

标签: excel vba excel-vba outlook

我的最终目标是在Excel vba中打开一个eml文件,最后在一个字符串中结束消息正文,然后我可以使用它来搜索不同的参数。我使用MailItem和Outlook应用程序找到了一个解决方案,但运行此代码时我正在处理错误的机器:

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

Outlook 2013打开,但后来给我一条错误消息,说OLMAPI32.dll然后崩溃​​。最终,我收到错误429" ActiveX组件无法创建对象。"

我想要解决此错误或解决方法将eml文件的正文转换为字符串。我使用此代码成功获取了电子邮件的主题:

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "^Subject:"
Do Until objFile.AtEndOfStream
   strSearchString = objFile.ReadLine
   Set colMatches = objRegEx.Execute(strSearchString)
   If colMatches.Count > 0 Then
       Cells(i, n) = strSearchString
       i = i + 1
       Exit Do
   End If
Loop

然而,通过检查一些随机的eml文件,它似乎没有像我可以用主题标记文本正文的方法。

忽略i和n,它与这个问题不太相关。我只是将主题放在其他地方确定的单元格中。

感谢任何帮助。谢谢!

1 个答案:

答案 0 :(得分:0)

您是否尝试过使用.Body功能? This文章可能有所帮助。

请注意,此代码在Outlook内执行,而不是Excel。

Sub ExportToExcel(MyMail As MailItem) Dim strID As String, olNS As Outlook.Namespace Dim olMail As Outlook.MailItem Dim strFileName As String

'~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)

'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")

'~~> If not found then create new instance
If Err.Number <> 0 Then
    Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0

'~~> Show Excel
oXLApp.Visible = True

'~~> Open the relevant file
Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xls")

'~~> Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Sheet1")

lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1

'~~> Write to outlook
With oXLws
    '
    '~~> Code here to output data from email to Excel File
    '~~> For example
    '
    .Range("A" & lRow).Value = olMail.Subject
    .Range("B" & lRow).Value = olMail.SenderName
    .Range("C" & lRow).Value = olMail.Body
    '.Range("C" & lRow).Value = olMail.HTMLBody 
    '
End With

'~~> Close and Clean up Excel
oXLwb.Close (True)
oXLApp.Quit
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing

Set olMail = Nothing
Set olNS = Nothing
End Sub