Got it, let's work through this VBA task to extract data from your text file. You need to search for specific keywords ("Primary Contact Full" and "E-Mail") and capture the value from the line immediately after each keyword. Here's a practical, tested solution that builds on your existing ExtractData sub:

Full Working Code #

Sub ExtractData()
    Dim filePath As String
    Dim fileNum As Integer
    Dim currentLine As String
    Dim contactName As String
    Dim contactEmail As String
    Dim captureNameNextLine As Boolean
    Dim captureEmailNextLine As Boolean
    
    ' Replace this with your actual text file path
    filePath = "C:\Your\Directory\your_file.txt"
    
    ' Initialize flags to track when we need to capture the next line
    captureNameNextLine = False
    captureEmailNextLine = False
    
    ' Get a free file number and open the file for reading
    fileNum = FreeFile
    Open filePath For Input As #fileNum
    
    ' Loop through each line until we reach the end of the file
    Do Until EOF(fileNum)
        Line Input #fileNum, currentLine
        
        ' Check if we need to capture the name from this line
        If captureNameNextLine Then
            contactName = Trim(currentLine) ' Trim removes extra spaces
            captureNameNextLine = False ' Reset flag after capturing
        End If
        
        ' Check if we need to capture the email from this line
        If captureEmailNextLine Then
            contactEmail = Trim(currentLine)
            captureEmailNextLine = False ' Reset flag after capturing
        End If
        
        ' Look for our target keywords in the current line
        If InStr(1, currentLine, "Primary Contact Full", vbTextCompare) > 0 Then
            captureNameNextLine = True ' Next line is the contact name
        End If
        
        If InStr(1, currentLine, "E-Mail", vbTextCompare) > 0 Then
            captureEmailNextLine = True ' Next line is the email
        End If
        
        ' Optional: Exit early once both values are found to save processing time
        If contactName <> "" And contactEmail <> "" Then
            Exit Do
        End If
    Loop
    
    ' Always close the file when done
    Close #fileNum
    
    ' Do something with the extracted data (customize this part!)
    ' Example 1: Show results in a message box
    MsgBox "Extracted Data:" & vbCrLf & _
           "Primary Contact: " & contactName & vbCrLf & _
           "E-Mail: " & contactEmail
    
    ' Example 2: Write results to Excel cells
    ' Range("A1").Value = "Primary Contact"
    ' Range("B1").Value = contactName
    ' Range("A2").Value = "E-Mail"
    ' Range("B2").Value = contactEmail
End Sub

Key Details Explained #

• Flag-Based Capture: We use boolean flags (captureNameNextLine, captureEmailNextLine) to mark when we've found a keyword—this tells the code to grab the very next line as our target value.
• Case-Insensitive Search: vbTextCompare ensures the code finds keywords regardless of capitalization (e.g., "primary contact full" or "E-mail" will still trigger the capture).
• Clean Results: Trim() removes any leading/trailing whitespace from the extracted values, so you don't get extra spaces in your output.
• Early Exit: Once both values are found, the loop stops immediately to avoid unnecessary processing of the rest of the file.

Quick Adjustments for Edge Cases #

• If keyword and value are on the same line: If your text ever has something like Primary Contact Full: John Doe, you can split the current line instead of capturing the next one. Replace the flag logic with something like:

  If InStr(1, currentLine, "Primary Contact Full", vbTextCompare) > 0 Then
      contactName = Trim(Split(currentLine, "Primary Contact Full")(1))
  End If
  

• Error Handling: To avoid crashes if the file doesn't exist, add a check before opening:

  If Dir(filePath) = "" Then
      MsgBox "File not found at: " & filePath, vbExclamation
      Exit Sub
  End If
  

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