从电子邮件中提取第3行和第4行

时间:2015-09-13 09:05:30

标签: excel vba excel-vba email outlook

我需要从电子邮件中导出第3行和第4行。我有一个存储在Microsoft Outlook会话中的VBA代码。它运行良好,但它导出整个邮件正文。我只需要第3和第4行。

以下是示例代码:

Option Explicit

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")


    Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Leads").Items

End Sub
Private Sub Items_ItemAdd(ByVal item As Object)

    On Error GoTo ErrorHandler

    Dim Msg As Outlook.MailItem

    Dim oXL As Object
    Dim oWS As Object
    Dim lngRow As Long

    Set oXL = CreateObject("Excel.Application")

    oXL.Workbooks.Open FileName:="C:\temp\Mail_Export.xlsx", AddTOMRU:=False, UpdateLinks:=False


    Set oWS = oXL.Sheets("Sheet1")
    lngRow = oWS.Range("A" & oXL.Rows.Count).End(-4162).Offset(1).Row

    If TypeName(item) = "MailItem" Then
        Set Msg = item

        With oWS
            .cells(lngRow, 1).Value = Msg.SenderName
            .cells(lngRow, 2).Value = Msg.SenderEmailAddress
            .cells(lngRow, 3).Value = Msg.Body



        End With

        With oXL
            .activeworkbook.Save
            .activeworkbook.Close SaveChanges:=2 '
            .Application.Quit
        End With

        Set oXL = Nothing
        Set oWS = Nothing

    End If

ExitPoint:

    Exit Sub

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitPoint


    Resume

End Function

Mail_Export.xlsx会自动删除从" Leads" MS Outlook中的文件夹。但是,我只需要第3和第4行。

这是示例邮件正文:

Hi Team
Following people contacted your helpdesk:-
Name: ABC DEF
Email: abc.def@gmail.com
Thank you
XYZ Consultants

1 个答案:

答案 0 :(得分:3)

Msg.Body可能是以下形式:

  

Hi Team [CR] [LF]以下人士联系了您的服务台: - [CR] [LF]姓名:   ABC DEF [CR] [LF]电子邮件:abc.def@gmail.com [CR] [LF]谢谢[CR] [LF] XYZ   顾问

其中[CR]表示回车符,[LF]表示换行符。

以下内容会将Msg.Body分成几行:

Dim Lines() As String

Lines = Split(Msg.Body, vbCR & vbLF)

然后您可以使用以下内容提取第3行和第4行

.cells(lngRow, 3).Value = Lines(LBound(Lines)+2) & vbLF & _
                          Lines(LBound(Lines)+3)

我对这个问题How to copy Outlook mail message into excel using VBA or Macros的回答将让您更全面地了解Outlook邮件项目对VBA宏的影响。