时间戳

首页 > 解决方案 > 从网络驱动器文件夹打开 .msg 然后下载超链接

vba - 从网络驱动器文件夹打开 .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

我看过以下内容。

Access 2010 中的 UrlDownloadToFile - 未定义子或函数

自动打开电子邮件中的链接的 Outlook 脚本

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

需要注意的几点：

  1. 电子邮件由我以外的其他人保存到文件夹中。
  2. 我无权访问电子邮件发送到的 Outlook 收件箱。所以我不能直接从 Outlook 的电子邮件中提取它。
  3. 每个保存的 .msg 正文中大约有 100 个超链接。

我以前从未在 VBA 中使用过超链接。

标签： vbaoutlook

解决方案

首先，不要使用Application.CreateItemFromTemplate. 使用Application.Session.OpenSharedItem.

一旦你有了MailItem对象（你已经Attachments在上面的脚本中访问了集合），读取GetInspector属性（返回Inspector对象），然后使用Inspector.WordEditor来访问Word.Document对象。它暴露了Hyperlinks财产。

推荐阅读