这里有一些代码可以帮助你开始
电子邮件被分成几行
然后每一行在冒号字符处分割...“：”
（在进行拆分之前，每行末尾都会添加冒号，以便空白行不会产生错误）
然后根据每行的前几个字符采取行动
将本文末尾的代码放入excel工作簿
确保运行时 Outlook 已打开
在 Outlook 中启用 vba（宏）不是一个好主意，因为收到的电子邮件中可能存在安全问题
您可能已经知道的一些提示：
您可以通过将光标放在代码中的任意位置并重复按 F8 来单步执行代码
黄色高亮表示接下来将执行哪条指令
将鼠标指针悬停在变量名上将指示该变量的值（在任何断点处停止时）
在指令旁边的左侧灰色条内单击将设置断点（并非所有指令都“可断点”）（再次单击以清除）
如果没有断点，按 F5 将运行程序直到下一个断点或程序结束
使用“观察窗口”仔细检查对象（变量）
要调出监视窗口，请转到“菜单栏”...“视图”...“监视窗口”
将任意对象名或变量名拖入监视窗口，或右键单击并选择“添加监视”
然后你可以在断点停止时监控变量值
例如。从第三个 Dim 语句（或程序中的任何其他位置）拖动“topOlFolder”
利用“即时窗口”
按 ctrl-G 调出“即时窗口”...
任何“Debug.print”命令都会打印到“立即窗口”...
这用于显示您需要的任何调试信息，而不必在断点处停止
编写 vba 代码的一个很好的起点是“录制宏”，然后进入 vbe ide 并编辑生成的宏代码以满足您的需要
录制的宏中的很多代码是不必要的，可以缩短
例如，您可能在工作表“Sheet5”上，您需要从“Sheet2”中删除所有内容并继续处理“Sheet5”：
您将为以下操作录制一个宏：
“点击Sheet2标签...选择所有单元格（ctrl-a）...按删除...点击Sheet5标签”
产生以下宏
Sub Macro1()
Sheets("Sheet2").Select
Cells.Select
Selection.ClearContents
Sheets("Sheet5").Select
End Sub
可以改写为：
Sub Macro1()
Sheets("Sheet2").Cells.ClearContents
End Sub
这会清除名为“Sheet2”的工作表而不“选择”它，因此它不会在屏幕上短暂闪烁
如果某些代码对不同的工作表进行了大量更新，并且每次更新都会在屏幕上短暂闪现，这可能会很烦人
这是你的代码
Sub Extract()
' On Error Resume Next ' do not use .... masks errors
Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim topOlFolder As Outlook.MAPIFolder
Dim myOlFolder As Outlook.Folder
Dim myOlMailItem As Outlook.mailItem
Set myOlApp = Outlook.Application ' roll these two into one command line
Set myNameSpace = myOlApp.GetNamespace("MAPI") ' as noted on next line
' Set myNameSpace = Outlook.Application.GetNamespace("mapi") ' can do this instead (then no need to do "dim myOlApp" above)
Set topOlFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Parent ' top folder ... contains all other folders
' Set myOlFolder = myNameSpace.Folders(2).Folders("Test") ' this one is unreliable ... Folders(2) seems to change
Set myOlFolder = topOlFolder.Folders("Test") ' this one seems to always work
' Set myOlFolder = topOlFolder.Folders(myNameSpace.PickFolder.Name) ' pick folder name in a dialog
' Debug.Print myOlFolder.Items.Count
' For Each myOlMailItem In myOlFolder.Items ' print subject lines for all emails in "Test" folder
' Debug.Print myOlMailItem.Subject
' Next
Dim xlObj As Worksheet
Set xlObj = Sheets("Sheet1") ' refer to a specific worksheet
' Set xlObj = ActiveSheet ' whichever worksheet is being worked on
Dim anchor As Range
Set anchor = xlObj.Range("b2") ' this is where the resulting table is placed ... can be anywhere
' Set anchor = Sheets("Sheet1").Range("b2") ' "xlObj" object does not have to be created if you use this form
' Set headings
' Offset(row,col)
anchor.Offset(0, 0).Value = "Priority" ' technically the line should be "anchor.Value = ...", but it lines up this way
anchor.Offset(0, 1).Value = "Summary" ' used "offset". that way all the cells are relative to "anchor"
anchor.Offset(0, 2).Value = "Description of Trouble"
anchor.Offset(0, 3).Value = "Device"
anchor.Offset(0, 4).Value = "Sender"
Dim msgText As String
Dim msgLine() As String
Dim messageArray() As String
i = 0 ' adjust excel starting row here, if desired
For Each myOlMailItem In myOlFolder.Items
i = i + 1 ' first parsed message ends up on worksheet one row below headings
' msgText = testText ' use test message that is defined above
msgText = myOlMailItem.Body ' or use actual email body
messageArray = Split(msgText, vbCrLf) ' split into lines
For j = 0 To UBound(messageArray)
' Debug.Print messageArray(j)
msgLine = Split(messageArray(j) & ":", ":") ' split up line ( add ':' so that blank lines do not error out)
Select Case Left(msgLine(0), 6) ' check only first six characters
Case "Priori"
anchor.Offset(i, 0).Value = msgLine(1) ' text after "Priority:"
Case "Summar"
anchor.Offset(i, 1).Value = messageArray(j + 1) ' text on next line
Case "Descri"
anchor.Offset(i, 2).Value = messageArray(j + 1) ' text on next line
Case "Device"
anchor.Offset(i, 3).Value = msgLine(1) ' text after "Device:"
End Select
anchor.Offset(i, 4).Value = myOlMailItem.SenderName
anchor.Offset(i, -1).Value = i ' add row number on left of "Priority" column (make sure that "anchor" is not in first worksheet column)
Next
Next
End Sub