从选定的Outlook电子邮件中提取2个字符串中的文本

Question

我有代码将电子邮件正文数据从Outlook导入Excel。我只需要电子邮件中的姓名，ID和代码。

除了从固定句子中提取ID之外，我已经做了所有事情：

cn = SVCLMCH，OU =用户，OU = CX，DC = dm001，DC = corp，DC = dcsa，DC = with

在这种情况下，id是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

你可以使用这样的辅助函数：

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)))

Answer 3

使用Regular Expression从ID中提取sentence

例子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