Question

我需要从邮件正文中提取用户名和链接，并将其写到Excel工作表中。我有一个宏，但是到提取部分时，下标一直超出范围。

我从中提取的通用电子邮件如下：

您好用户名，

我代表组织邀请您使用该应用程序。请点击下面的链接以回复此邀请：

https://application/invite/numbers-numbers/

此邀请将在日期之前过期，除非较早接受或拒绝。

如果您需要任何帮助来接受此邀请或创建帐户，请与我们联系。

当前，我正在使用以下Outlook宏：

    Option Explicit
    Sub CopyUserPasswordToExcel()
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim olItem As Outlook.MailItem
    Dim vText As Variant
    Dim sText As String
    Dim vItem As Variant
    Dim i As Long
    Dim rCount As Long
    Dim bXStarted As Boolean
    Const strPath As String = >"C:\Users\User\Documents\UserPassword.xlsx"

    If Application.ActiveExplorer.Selection.Count = 0 Then
    MsgBox "No Items selected!", vbCritical, "Error"
    Exit Sub
    End If

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")

    If Err <> 0 Then
    Application.StatusBar = "Please wait while Excel source is opened ... "
    Set xlApp = CreateObject("Excel.Application")
    bXStarted = True
    End If
    On Error GoTo 0
    'Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("Sheet1")

    rCount = xlSheet.UsedRange.Rows.Count
    For Each olItem In Application.ActiveExplorer.Selection
    sText = olItem.Body 'Gets the body of each selected outlook item
    vText = Split(sText, Chr(13)) 'Splits the body into Array vText

    '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), "Hi") > 0 Then
    vItem = Split(vText(i), Chr(32))
    xlSheet.Range("A" & rCount) = Trim(vItem(2))
    End If

    If InStr(1, vText(i), "https") > 0 Then
    vItem = Split(vText(i), Chr(32))
    xlSheet.Range("B" & rCount) = Trim(vItem(5))
    End If

    Next i
    xlWB.Save
    Next olItem
    xlWB.Close SaveChanges:=True
    If bXStarted Then
    xlApp.Quit
    End If

    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
    Set olItem = Nothing
    End Sub

我希望在工作表1的A列中填充用户名，在B列中填充相关链接。

但是我总是下标超出范围。我认为没有找到要提取的消息正文中的行。

如何使用宏从电子邮件正文中提取字符串？

0 个答案: