问我在outlook中创建了一个宏来将电子邮件数据导出到excel，但是在其中一个单元格的末尾添加了“<https”。我怎样才能解决这个问题？

EN

Option Explicit

Sub CopyToExcel()
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 = "P:\Yard Check\AkronYardCheck.xlsx" 'the path of 
the workbook

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

'Process each selected record
rCount = xlSheet.UsedRange.Rows.Count
For Each olItem In Application.ActiveExplorer.Selection
sText = olItem.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), "Trailer Number:") > 0 Then
        vItem = Split(vText(i), Chr(58))
        xlSheet.Range("A" & rCount) = Trim(vItem(1))
    End If

    If InStr(1, vText(i), "Loaded/Empty:") > 0 Then
        vItem = Split(vText(i), Chr(58))
        xlSheet.Range("B" & rCount) = Trim(vItem(1))
    End If

    If InStr(1, vText(i), "Notes:") > 0 Then
        vItem = Split(vText(i), Chr(58))
        xlSheet.Range("C" & rCount) = Trim(vItem(1))
    End If

    If InStr(1, vText(i), "Additional Info:") > 0 Then
        vItem = Split(vText(i), Chr(58))
        xlSheet.Range("D" & rCount) = Trim(vItem(1))
    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