Извлечь текст из 2 строк из выбранной электронной почты Outlook

Question

У меня есть код для импорта данных тела письма из Outlook в Excel. Мне нужно только имя, идентификатор, код из письма.

Я сделал все, кроме извлечения идентификатора из фиксированного предложения:

сп = SVCLMCH, OU = Users, OU = CX, DC = dm001, DC = АМФ, DC = DCSA, DC = COM

Идентификатор в этом случае - SVCLMCH, это означает, что мне нужно извлечь текст между "cn =" и ", OU = Users" .

Sub import_code()

Dim O As Outlook.Application
Set O = New Outlook.Application

Dim ONS As Outlook.Namespace
Set ONS = O.GetNamespace("MAPI")

Dim OMAIL As Outlook.MailItem
Set OMAIL = Nothing

Dim ws As Object
Set ws = ThisWorkbook.Worksheets("Import code from Outlook")

Dim rcount As Long
Dim vText As Variant
Dim sText As String
Dim i As Long

If O.ActiveExplorer.Selection.Count = 0 Then
    msgbox "No Items selected!", vbCritical, "Error"
End If

On Error Resume Next

'Process each selected record
rcount = ws.UsedRange.Rows.Count
For Each OMAIL In O.ActiveExplorer.Selection
    sText = OMAIL.Body
    vText = Split(sText, Chr(13))
    'Find the next empty line of the worksheet
     rcount = rcount + 1
    'Check each line of text in the message body
    For i = UBound(vText) To 0 Step -1

        If InStr(1, vText(i), "Password Generated and set for:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            ws.Range("A" & rcount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "cn=") > 0 Then
            vItem = Split(vText(i), Chr(58))
            ws.Range("b" & rcount) = Trim(vItem(1))
    End If

    If InStr(1, vText(i), "Password:") > 0 Then
        vItem = Split(vText(i), Chr(58))
        ws.Range("c" & rcount) = Trim(vItem(1))
    End If

Next i

Next OMAIL

End Sub

Answer 1

Хитрость в том, чтобы использовать функцию Split ()

Dim Arr() As String
Dim j As Integer
Dim k As Integer
Dim strvar As String
Dim strval As String
Dim strID As String

If InStr(1, vtext(i), "cn=") > 0 Then

    ' split the whole line in an array - "," beeing the value separator
    Arr = Split(vtext(i), ",")

    ' loop through all array elements
    For j = 0 To UBound(r) - 1

        ' find the position of =
        k = InStr(Arr(j), "=")

        strvar = Left(Arr(j), k - 1) ' this is the variable name, ie "cn"
        strval = Mid(Arr(j), k + 1) ' this is the value, ie "SVCLMCH"

        ' now do what you want with a specific variable

        Select Case strvar

            Case "cn"
                strID = strval

            Case Else
                ' do nothing
        End Select

    Next j

End If

Answer 2

Использование Регулярное выражение извлечение ID из предложения

Пример Pattern = "(?<=cn=)([^.]+)(?=\,OU=Users)"

https://regex101.com/r/67u84s/2

Пример кода

Option Explicit
Private Sub Examplea()
    Dim Matches As Variant

    Dim RegEx As Object
    Set RegEx = CreateObject("VbScript.RegExp")

    Dim olApp As Object
    Set olApp = CreateObject("Outlook.Application")

    Dim Item As Outlook.MailItem
    Set Item = olApp.ActiveExplorer.Selection.Item(1)

    Dim Pattern As String
        Pattern = "(?<=cn=)([^.]+)(?=\,OU=Users)"
    With RegEx
        .Global = False
        .Pattern = Pattern
        .IgnoreCase = True
         Set Matches = .Execute(Item.Body)
    End With

    If Matches.Count > 0 Then
        Debug.Print Matches(0).SubMatches(0)
        With ThisWorkbook.Sheets("Sheet1")
            .Range("A1").Value = Trim(Matches(0).SubMatches(0))
        End With
    End If
End Sub

Answer 3

Вы можете использовать вспомогательную функцию , например:

Function GetID(strng As String)
    Dim el As Variant

    For Each el In Split(strng, ",")
        If InStr(1, el, "cn=") > 0 Then
            GetID = Mid(el, InStr(1, el, "cn=") + 3)
            Exit Function
        End If
    Next
End Function

и ваш основной код будет использовать его как:

If InStr(1, vText(i), "cn=") > 0 Then ws.Range("b" & rcount) = GetID(CStr(vText(i)))