Outlook 删除附件

Question

我试图获得一个宏来一次保存 Outlook 中多封电子邮件的附件。我只是在 Word VBA 中进行了修补并获得了成功的结果，这对于像我这样的菜鸟来说显然太过分了。

我尝试搜索一个已经完成的宏，并在此页面 (Save attachments to a folder and rename them) 上找到了一个，然后我将宏从最有用的答案复制到了我的 Outlook VBA 中。愚蠢的我在几乎所有我想做的电子邮件上运行宏，现在附件不再存在，而是显示消息：

“C:\Users\fran1\Documents\Attachments\BATMAN_WEI2-1_3470_001.pdf”

每个文件。

但是，该文件夹不存在，链接已损坏，我似乎无法手动找到等效文件夹。我的问题是，这些文件是否存储在我的计算机中的某个位置？如果是这样，我该如何找回它们？我曾尝试使用他们的文件名（非常具体）寻找他们，但无济于事。这些文件是从扫描仪生成的自动 PDF，因此要取回文件，我需要再次扫描文档，这需要一些时间，因此我热衷于取回附件文件。非常欢迎任何关于宏可能对文件所做的事情的回答。最坏的情况是，我将不得不再花 90 分钟扫描文档。

Answer 1

虽然不是恢复文件的答案（尽管您可以根据 cmets 检查 OLK 文件夹），但您可能需要一个功能更好的 VBA 脚本来保存将来的附件；因此，以下是从选定电子邮件中保存（并在需要时安全删除）附件的代码。

除非设置为这样做，否则不会保存或从电子邮件中删除重复的文件名。

将 FilePath 更新到您要保存文件的位置

Public Sub SaveAttachmentsFromSelectedEmails()
    Dim olItem As Outlook.MailItem
    Dim olSelection As Outlook.Selection: Set olSelection = ActiveExplorer.Selection
    Dim FilePath As String: FilePath = Environ("USERPROFILE") & "\Documents\Documents\Attachments"
    
    If Dir(FilePath, vbDirectory) = "" Then
        Debug.Print "Save folder does not exist"
        Exit Sub
    End If
    
    For Each olItem In olSelection
        SaveAttachments olItem, FilePath, RemoveAttachments:=False
    Next olItem
End Sub

Function SaveAttachments(ByVal Item As Object, FilePath As String, _
    Optional FileExtensions As String = "*", _
    Optional Delimiter As String = ",", _
    Optional RemoveAttachments As Boolean = False, _
    Optional OverwriteFiles As Boolean = False) As Boolean
    
    On Error GoTo ExitFunction
    
    Dim i As Long, j As Long, FileName As String, Flag As Boolean
    Dim Extensions() As String: Extensions = Split(FileExtensions, Delimiter)
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
    
    For j = LBound(Extensions) To UBound(Extensions)
        With Item.Attachments
            If .Count > 0 Then
                For i = .Count To 1 Step -1
                    FileName = FilePath & .Item(i).FileName
                    Flag = IIf(LCase(Right(FileName, Len(Extensions(j)))) = LCase(Extensions(j)), True, False)
                    Flag = IIf(FileExtensions = "*" Or Flag = True, True, False)
                    If Flag = True Then
                        If Dir(FileName) = "" Or OverwriteFiles = True Then
                            .Item(i).SaveAsFile FileName
                        Else
                            Debug.Print FileName & " already exists"
                            Flag = False
                        End If
                    End If
                    If RemoveAttachments = True And Dir(FileName) <> "" And Flag = True Then .Item(i).Delete
                Next i
            End If
        End With
    Next j
    SaveAttachments = True

ExitFunction:
End Function