如何从Outlook邮件提取超链接到Excel？

Question

我正在尝试提取超链接。邮件中有几个超链接，但是此链接用于下载文件，其中包含单词“下载”。

我每天收到多封相同格式的邮件。这就是为什么我需要自动化下载过程。

第一步，我在两个模块中使用下面的代码提取到Excel的必需链接

模块1

Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet

Sub ExportAllHyperlinksInMultipleEmailsToExcel()
Dim objSelection As Selection
Dim objMail As MailItem
Dim objMailDocument As Document
Dim objHyperlink As Hyperlink
Dim i As Long
Dim s As String

Set objSelection = Outlook.Application.ActiveExplorer.Selection

If Not (objSelection Is Nothing) Then

   Set objExcelApp = CreateObject("Excel.Application")
   Set objExcelWorkbook = objExcelApp.Workbooks.Add
   Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
   objExcelApp.Visible = True
   objExcelWorkbook.Activate

   With objExcelWorksheet
        .Cells(1, 1) = "No."
        .Cells(1, 2) = "Address"

  End With

  On Error Resume Next
  i = 0
  For Each objMail In objSelection
      objMail.Display
      Set objMailDocument = objMail.GetInspector.WordEditor
      If objMailDocument.Hyperlinks.Count > 0 Then
         For Each objHyperlink In objMailDocument.Hyperlinks
              If InStr(10, objHyperlink.Address, "download") > 40 Then
                i = i + 1
                s = CStr(objHyperlink.Address)
                Call Module2.ExportToExcel(i, s, objExcelWorksheet)
             End If
         Next
      End If
      objMail.Close olDiscard
  Next
End If
End Sub

模块2

  Sub ExportToExcel(n As Long, j As String, objExcelWorksheet AsExcel.Worksheet)

 Dim nLastRow As Integer

nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1

objExcelWorksheet.Range("A" & nLastRow).Value = CStr(n)
objExcelWorksheet.Range("B" & nLastRow).Value = j

End Sub

代码会运行，但是生成的Excel仅在A列中显示值（邮件编号）。应具有超链接地址的B列保留为空白。

Answer 1

首先，无需调用Display方法就可以在单独的窗口（检查器）中显示邮件项目。

For Each objMail In objSelection
     ' objMail.Display

该超链接的地址应保留为空白。

         For Each objHyperlink In objMailDocument.Hyperlinks
              If InStr(10, objHyperlink.Address, "download") > 40 Then
                i = i + 1                
                Call Module2.ExportToExcel(i, objHyperlink.Address, objExcelWorksheet)
             End If
         Next

无需将返回值强制转换为字符串。 Hyperlink.Address属性以字符串形式返回指定超链接的地址（例如，文件名或URL）。

Answer 2

我想出了使用以下功能复制超链接的链接，现在它可以正常工作了！谢谢每一个人

objMailDocument.Hyperlinks(5).Address '5 is the number of the hyperlink which I need to extract the link from