将一些电子邮件行复制到Excel

时间:2015-10-09 06:49:29

标签: excel vba excel-vba outlook

我试图将电子邮件正文的某些行复制到Excel。

电子邮件示例:

hi team,
please find the following servers
1.1.1.2
1.1.1.3
1.1.4.1
end of email

我想搜索文件夹中的电子邮件并查找字符串之间的行"请找到以下服务器"和"电子邮件结束",然后连续复制每一行。

到目前为止,我的代码将整个电子邮件正文复制到单行。

Sub CopyEmail2Excel()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As Object
Dim mai As MailItem

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
i = 0
If Inbox.Items.Count = 0 Then
    MsgBox "Inbox is Empty", vbInformation, "Nothing Found"
End If
For Each item In Inbox.Items
    If item.Subject Like "Server list" Then
        vBody = item.body
        Dim xlApp As Object ' Excel.Application
        Dim xlWkb As Object ' Excel.Workbook
        Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
        xlApp.Visible = True
        Set xlWkb = xlApp.Workbooks.Add
        xlApp.Range("A2").Value = vBody
    End If
Next
Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing

End Sub

2 个答案:

答案 0 :(得分:0)

HI使用行拆分邮件正文,尝试使用此代码

 MyOutLookBody = Split(myItem.Body, vbCrLf)
     For i = 0 To UBound(MyOutLookBody)
        If MyOutLookBody(i) <> "" Then
           Call WriteTextFile(StrFile, MyOutLookBody(i))
        End If
Next

答案 1 :(得分:0)

谢谢你的帮助。我做了一些研究来了解事情,最终能够解决问题。

Sub ol2excel()
Dim oAccount As Outlook.Account
Dim oMail As Outlook.MailItem
Dim text() As String
Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object ' Excel.Workbook
Dim host() As String

For Each oAccount In Application.Session.Accounts
    If oAccount = "#original Account name#" Then
        Set oMail = Application.ActiveExplorer.Selection(1)
text() = Split(Replace(oMail.body, "end", "servers"), "servers")
content = text(1)
msgbox content

Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
xlApp.Visible = True
Set xlWkb = xlApp.Workbooks.Add
xlApp.Range("A1") = content

    End If
Next

End Sub