String 从电子邮件中提取URL字符串，去掉所有其他文本

我有一个vba脚本，可以提取电子邮件的文本。我能够选择具体的电子邮件没有问题，并调试打印到一个文件。我不知道如何在同一个脚本中提取或缩减我需要的确切行：

Public Function GetEmailString()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder  As Outlook.MAPIFolder
Dim olItem As Outlook.Items
Dim olMail As Variant
Dim i As Long
Dim s As String
Dim n As Integer

n = FreeFile()

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders("Test")
Set olItem = olFolder.Items

olItem.Sort “Subject”

i = 1

For Each olMail In olItem
    If InStr(olMail.Subject, "UPS Report Available") > 0 Then
    Open "D:\test.txt" For Output As #n
        s = olMail.body
        Debug.Print s ' write to immediate
        Print #n, s ' write to file
        Close #n
        i = i + 1
    End If
Next olMail
End Function

The contents of the email are this:

At the request of whoever of Test Company, this notification provides access to reports regarding shipper shipment information. The reports are available for download by accessing the link provided below.

Do not reply to this e-mail. Shipper Company and Whoever of Test Company will not receive your reply.

Message from Whoever of Test Company:
Daily Quantum View Report for 1V0650

Reports Available for Download:
https://www.ups.com/email-qvm/downloadCVRpt?id=Ym)Wm4K1t4EyTVWj3Bcm3BZNlhj2Io(86B3YZ0rzJQ6dxEL4O6S(BTNtF08IcdWvoPiJ9JGgw7(SrxzFI6(4yItUToowZLPI)rkb2o7HRxtHUFPz6GMiNnjsI6G)j(iKEWkTDKnH7YnwNeBEDUAPw__&loc=en_US

This e-mail was automatically generated by Shipper Company e-mail services at the request of Whoever of Test Company. Shipping Company and Whoever of Test Company will not receive any reply to this email. Please contact Whoever of Test Company directly if you have questions regarding the referenced shipment or wish to discontinue this notification service.

我可以将其打印到文本文件中，我需要将其精简为以下内容：

https://www.ups.com/email-qvm/downloadCVRpt?id=Ym)Wm4K1t4EyTVWj3Bcm3BZNlhj2Io(86B3YZ0rzJQ6dxEL4O6S(BTNtF08IcdWvoPiJ9JGgw7(SrxzFI6(4yItUToowZLPI)rkb2o7HRxtHUFPz6GMiNnjsI6G)j(iKEWkTDKnH7YnwNeBEDUAPw__&loc=en_US

---

有人有什么想法吗？最后，我试图在一个文本文件中获取一个字符串，以便以后读取它并使用xttp将此链接自动生成的csv文件下载到access数据库表中。

我想出了一个简单的方法来返回我需要的内容。然后，我将把它写入另一个文件，并将其收集起来，供数据库读取：

Public Function ReadFiles()
Dim fso As New Scripting.FileSystemObject
Dim fsoFolder As Scripting.Folder
Dim fsoFile As File
Dim FileText As TextStream
Dim TextLine As String
Dim key As String ' Part before ":"

Dim strPath As String
Dim strFile As String
Dim strPandF As String
Dim strLine As String

strPath = "D:\"
strFile = "Test.txt"
strPandF = "D:\Test.txt"

Set fso = CreateObject("Scripting.FileSystemObject") 'New FileSystemObject
Set fsoFolder = fso.GetFolder(strPath)
Set fsoFile = fso.GetFile(strPandF)
Set FileText = fsoFile.OpenAsTextStream(ForReading)
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine 'read line
key = "https://www.ups.com/email-qvm"
If Left(TextLine, 29) = key Then

MsgBox TextLine
End If
Loop

FileText.Close

End Function