Question

我的目标是打开所有保存在共享驱动器文件夹中的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中使用过超链接。

Answer 1

首先，请勿使用Application.CreateItemFromTemplate。使用Application.Session.OpenSharedItem。

一旦拥有MailItem对象（您已经在上面的脚本中访问Attachments集合），请读取GetInspector属性（返回Inspector对象），然后使用{ {1}}访问Inspector.WordEditor对象。它公开了Word.Document属性。

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

1 个答案: