Excel 分析Outlook电子邮件中标识标签下一行的文本

我正在尝试将数据从电子邮件表单传输到Excel

电子邮件的格式如下

提交表格：

选择位置：
堆叠
名字：
约翰
姓氏：
Doe
电话号码：
07555
电子邮件：
约翰。doe@example.com
查询字符串：

我想使用分隔符来分隔变量字符串

我试图调整一个类似的代码，但这并不能正确地分离信息

Sub Extract1()

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
Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set myOlFolder = myOlApp.ActiveExplorer.CurrentFolder




Set xlObj = CreateObject("excel.application")
xlObj.Visible = True
xlObj.Workbooks.Add

Set anchor = xlObj.Range("a1")

anchor.offset(0, 0).Value = "Place"
anchor.offset(0, 1).Value = "First"
anchor.offset(0, 2).Value = "Last"
anchor.offset(0, 3).Value = "Phone"
anchor.offset(0, 4).Value = "Email"


Dim msgText As String
Dim msgLine() As String
Dim messageArray() As String

i = 0
      For Each myOlMailItem In myOlFolder.Items

    i = i + 1


    msgText = myOlMailItem.Body

    messageArray = Split(msgText, vbCrLf)

    For j = 0 To UBound(messageArray)

        msgLine = Split(messageArray(j) & ":", ":")

        Select Case Left(msgLine(0), 5)

            Case "Select"
                anchor.offset(i, 0).Value = messageArray(j + 1)

            Case "First"
                anchor.offset(i, 1).Value = messageArray(j + 1)

            Case "Last "
                anchor.offset(i, 2).Value = messageArray(j + 1)

            Case "Phone"
                anchor.offset(i, 3).Value = messageArray(j + 1)

            Case "Email"
                anchor.offset(i, 4).Value = messageArray(j + 1)

        End Select


    Next
Next
End Sub

结果的格式应如下所示

Place     First     Last     Phone         Email
STACK     John      Doe      07555555555   john.doe@example.com

---

因此，目前它只是没有复制选择…我觉得我真的很愚蠢。

vbCrLf是您当前或以前代码的答案。剩下的只是调试

使用您当前的代码，使用测试电子邮件，并从样本中复制/粘贴文本

Option Explicit

Sub Extract2()

    'Dim myOlApp As Outlook.Application     ' Not necessary if code in Outlook
    'Dim myNameSpace As Outlook.namespace   ' Not used
    'Dim topOlFolder As Outlook.MAPIFolder  ' Necessary for 2003

    Dim topOlFolder As folder               ' 2007 and subsequent
    Dim myOlFolder As folder

    'Dim myOlMailItem As mailItem
    ' The type of item in a folder is not necessarily a mailitem
    Dim myOlMailItem As Object

    Dim xlObj As Object
    Dim Anchor As Object
    Dim i As Long
    Dim j As Long

    'Set myOlApp = Outlook.Application
    'Set myNameSpace = myOlApp.GetNamespace("MAPI")

    'Set myOlFolder = myOlApp.ActiveExplorer.CurrentFolder
    Set myOlFolder = ActiveExplorer.CurrentFolder

    Set xlObj = CreateObject("excel.application")
    xlObj.Visible = True
    xlObj.Workbooks.Add

    Set Anchor = xlObj.Range("a1")

    Anchor.Offset(0, 0).Value = "Place"
    Anchor.Offset(0, 1).Value = "First"
    Anchor.Offset(0, 2).Value = "Last"
    Anchor.Offset(0, 3).Value = "Phone"
    Anchor.Offset(0, 4).Value = "Email"

    Dim msgText As String
    'Dim msgLine() As String
    Dim messageArray() As String

    i = 1

    'Perhaps instead
    'i = 0

    ' You should have indicated there was an error in this line
    'For Each myOlMailItem In myOlFolder
    For Each myOlMailItem In myOlFolder.Items

        If myOlMailItem.Class = olMail Then

            Debug.Print myOlMailItem.subject

            i = i + 1

            msgText = myOlMailItem.body

            messageArray = Split(msgText, vbCrLf)

            For j = 0 To UBound(messageArray)

                ' this seems unnecessary
                'msgLine = Split(messageArray(j) & ":", ":")
                'Select Case Left(msgLine(0), 5)

                Debug.Print "Left(messageArray(j), 5): " & Left(messageArray(j), 5)
                Select Case Left(messageArray(j), 5)

                'Case "Select"
                ' Typo
                Case Left("Select", 5)

                    Debug.Print "messageArray(j): " & messageArray(j)
                    Debug.Print "messageArray(j + 1): " & messageArray(j + 1)
                    Debug.Print "messageArray(j + 2): " & messageArray(j + 2)
                    'Anchor.Offset(i, 0).Value = messageArray(j + 1)
                    Anchor.Offset(i, 0).Value = messageArray(j + 2)

                Case "First"
                    'Anchor.Offset(i, 1).Value = messageArray(j + 1)
                    Anchor.Offset(i, 1).Value = messageArray(j + 2)

                Case "Last "
                    'Anchor.Offset(i, 2).Value = messageArray(j + 1)
                    Anchor.Offset(i, 2).Value = messageArray(j + 2)

                Case "Phone"
                    'Anchor.Offset(i, 3).Value = messageArray(j + 1)
                    Anchor.Offset(i, 3).Value = messageArray(j + 2)

                Case "Email"
                    'Anchor.Offset(i, 4).Value = messageArray(j + 1)
                    Anchor.Offset(i, 4).Value = messageArray(j + 2)

                End Select

                ' You should have indicated there was an error in this line
                ' Appears to be unnecessary anyway
                'Anchor.Offset(i, -1).Value = i

            Next

        End If

    Next

End Sub

---

我应该指出，这确实可以很好地分割标题，但整个电子邮件正文随后会粘贴到下一行的第一列。首先，从您的曲目中删除出错时的

，然后继续下一行，直到您不再是noob为止。这告诉您的代码完全忽略所有可能出现的错误。它有合法的用途，但它们很少。第二，代码给了你什么？将实际结果编辑到操作中。在VB编辑器中，单击“工具”菜单上的“选项”，然后单击“编辑器”选项卡，然后单击“需要变量声明”复选框。这将在新模块的顶部生成显式选项。现在，请在现有模块的顶部手动键入此内容。这也有助于修复变量中的拼写错误
delimitedMessage
vs
delimitedMessage
修复了拼写错误，而且现在上面的代码似乎根本不起作用：/
Option Explict
会有很大帮助，但您似乎仍然看不到声明变量的好处。进行这些更改，使您的问题进入可能需要回答的状态
delimitedMessage=myItem.body
，“选择地点：”而不是“选择地点：”，“名字：”，“姓氏：”和“电话号码：”。我现在对代码有了更多的了解。由于某些原因，这不会将选定的数据粘贴到图纸中。它只创建标题，然后循环，而不选择任何内容或将任何内容粘贴到第二行中。似乎找到了空白。请参见编辑的代码。如果仍在查找空白，请按照相同的过程查找非空白。这里有一个链接，指向一个粘贴箱，其中包含电子邮件的发送方式。当我调整J元素时，它可能会识别第一个项目的正确行，但当它循环到另一个项目时，它就不会识别。它还没有在excel中打印。我很感谢你的帮助，我只是想打断这个问题，因为我还没有一个完整的解决方案：P