时间戳

首页 > 解决方案 > 从选定 Outlook 电子邮件的 2 个字符串中提取文本

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

问题描述

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

除了从固定句子中提取 ID 之外，我已经完成了所有操作：

cn=SVLMCH,OU=用户,OU=CX,DC=dm001,DC=corp,DC=dcsa,DC=com

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

标签： regexexcelvbaoutlook

解决方案

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

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

推荐阅读