从网络驱动器文件夹打开.msg然后下载超链接

我的目标是打开保存在共享驱动器文件夹中的所有Outlook .msg文件 . 打开每封电子邮件后，打开电子邮件正文中包含的超链接，并保存从该链接打开的文件 . 理想情况下，我会跳过与其他链接不同的链接 .

这是我用来打开.msg文件和保存附件的代码 . 我想我可以重用其中的一部分来打开超链接 .

Sub SaveAttachments()

    Dim msg As Outlook.MailItem
    Dim att As Outlook.Attachment
    Dim strFilePath As String
    Dim strAttPath As String
    Dim colFiles As New Collection, f
    Dim posr As String

    'path for msgs
    strFilePath = "R:\AP\FY18\"

    GetFiles strFilePath, "*.msg", True, colFiles

    'path for saving attachments
    strAttPath = "R:\AP\Testing Extracts\"

    For Each f In colFiles
        Set msg = Application.CreateItemFromTemplate(f)
        If msg.Attachments.Count > 0 Then
            For Each att In msg.Attachments
                posr = InStrRev(att.filename, ".")
                ext = Right(att.filename, Len(att.filename) - posr)
                posl = InStr(att.filename, ".")
                fname = Left(att.filename, posr - 1)
                att.SaveAsFile strAttPath & "\" & fname & "_" & Format(msg.ReceivedTime, "ddmmyyyy_hhmm") & "." & ext
'               att.SaveAsFile strAttPath & att.FileName
            Next
        End If
    Next

End Sub

Sub GetFiles(StartFolder As String, Pattern As String, _
             DoSubfolders As Boolean, ByRef colFiles As Collection)

    Dim f As String, sf As String, subF As New Collection, s

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        colFiles.Add StartFolder & f
        f = Dir()
    Loop

    sf = Dir(StartFolder, vbDirectory)
    Do While Len(sf) > 0
        If sf <> "." And sf <> ".." Then
            If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                    subF.Add StartFolder & sf
            End If
        End If
        sf = Dir()
    Loop

    For Each s In subF
        GetFiles CStr(s), Pattern, True, colFiles
    Next s

End Sub

我见过以下内容 .

UrlDownloadToFile in Access 2010 - Sub or Function not Defined

outlook script that automatically opens links in emails

这些链接中的第二个引导我 HTMLBody . 我设法创建了一封新电子邮件，而不是打开已保存电子邮件中的链接 .

有几点需要注意：

• 电子邮件由我以外的人保存到文件夹中 .

• 我无法访问发送电子邮件的Outlook收件箱 . 所以我不能直接从outlook中的电子邮件中提取它 .

• 每个.msg的正文中大约有100个超链接 .

我之前从未使用过VBA中的超链接 .