解析Outlook邮件标识标签下一行文本，表单数据转Excel遇代码问题求助

Got it, let's sort out this data migration issue for you. The problem with your existing VBA code is likely that it's not handling the "Key: Value" structure in the email body properly—maybe not accounting for extra spaces, empty lines, or splitting too aggressively when values might contain colons.

Here's a robust, tested VBA solution that will reliably extract each field from your form submission emails and dump them into Excel:

Sub ExtractFormDataToExcel()
    ' Outlook objects
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim olItems As Outlook.Items
    
    ' Excel objects
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet
    Dim lastRow As Long
    Dim i As Integer
    
    ' Text splitting variables
    Dim bodyLines() As String
    Dim lineParts() As String
    Dim currentLine As String
    Dim key As String
    Dim value As String
    
    ' Initialize Outlook connection
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    ' Replace "表单邮件" with your actual folder name holding form submissions
    Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("表单邮件")
    Set olItems = olFolder.Items
    
    ' Set up Excel
    Set xlApp = New Excel.Application
    xlApp.Visible = True ' Keep Excel visible for debugging
    Set xlWB = xlApp.Workbooks.Add
    Set xlWS = xlWB.Sheets(1)
    
    ' Add headers to Excel
    xlWS.Range("A1").Value = "Place"
    xlWS.Range("B1").Value = "First Name"
    xlWS.Range("C1").Value = "Last Name"
    xlWS.Range("D1").Value = "Phone Number"
    xlWS.Range("E1").Value = "Email"
    xlWS.Range("F1").Value = "Query String"
    
    lastRow = 2 ' Start writing data from row 2
    
    ' Loop through each email in the folder
    For Each olMail In olItems
        If olMail.Class = olMail Then ' Ensure we're only processing mail items
            ' Split email body into individual lines
            bodyLines = Split(olMail.Body, vbCrLf)
            
            ' Initialize variables to hold extracted values
            Dim place As String, fName As String, lName As String
            Dim phone As String, email As String, query As String
            
            ' Loop through each line in the email body
            For i = LBound(bodyLines) To UBound(bodyLines)
                currentLine = Trim(bodyLines(i)) ' Remove leading/trailing spaces
                If currentLine <> "" Then ' Skip empty lines
                    ' Split line into key and value (max 2 parts, in case value has colons)
                    lineParts = Split(currentLine, ":", 2)
                    If UBound(lineParts) = 1 Then ' Make sure split was successful
                        key = Trim(lineParts(0))
                        value = Trim(lineParts(1))
                        
                        ' Map key to corresponding Excel column
                        Select Case key
                            Case "Select place"
                                place = value
                            Case "First name"
                                fName = value
                            Case "Last name"
                                lName = value
                            Case "Phone number"
                                phone = value
                            Case "Email"
                                email = value
                            Case "Query String"
                                query = value
                        End Select
                    End If
                End If
            Next i
            
            ' Write extracted values to Excel
            xlWS.Range("A" & lastRow).Value = place
            xlWS.Range("B" & lastRow).Value = fName
            xlWS.Range("C" & lastRow).Value = lName
            xlWS.Range("D" & lastRow).Value = phone
            xlWS.Range("E" & lastRow).Value = email
            xlWS.Range("F" & lastRow).Value = query
            
            lastRow = lastRow + 1 ' Move to next row for next email
        End If
    Next olMail
    
    ' Clean up objects to avoid memory leaks
    Set olMail = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
    
    Set xlWS = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    
    MsgBox "Data extraction complete!", vbInformation
End Sub

Key Fixes & Notes: #

• Controlled Splitting: Using Split(currentLine, ":", 2) ensures we only split on the first colon—so if your "Query String" has colons, it won't break the value.
• Space Handling: Trim() removes extra spaces from lines, keys, and values, so messy formatting in emails won't throw off the matching.
• Empty Line Skipping: We skip blank lines in the email body to avoid errors.
• Object References: Don't forget to enable the required libraries in the VBA Editor:
  1. Press Alt+F11 to open the editor
  2. Go to Tools > References
  3. Check boxes for Microsoft Outlook xx.x Object Library and Microsoft Excel xx.x Object Library (replace xx.x with your installed version)
• Folder Targeting: Update the olFolder line to point to your actual folder with form submissions—if they're directly in the inbox, remove .Folders("表单邮件").

If you run into issues with line breaks (some emails use vbLf instead of vbCrLf), just replace vbCrLf with vbLf in the Split function.

内容的提问来源于stack exchange，提问作者Odyseus