vba - Outlook 删除附件
问题描述
我试图获得一个宏来一次保存 Outlook 中多封电子邮件的附件。我只在 Word VBA 中进行了修补并取得了成功,这对于像我这样的菜鸟来说显然太过分了。
我尝试搜索一个已经完成的宏,并在此页面上找到了一个(将附件保存到文件夹并重命名它们)并将宏从最有用的答案复制到我的 Outlook VBA 中。愚蠢的我在几乎所有我想做的电子邮件上运行宏,现在附件不再存在,而是显示消息:
“C:\Users\fran1\Documents\Attachments\BATMAN_WEI2-1_3470_001.pdf”
对于每个文件。
但是,该文件夹不存在,链接已损坏,我似乎无法手动找到等效文件夹。我的问题是,这些文件是否存储在我的计算机中的某个位置?如果是这样,我该如何找回它们?我曾尝试使用他们的文件名(非常具体)寻找他们,但无济于事。这些文件是从扫描仪生成的自动 PDF,因此要取回文件,我需要再次扫描文档,这需要一些时间,因此我热衷于取回附件文件。非常欢迎有关宏可能对文件所做的任何回答。最坏的情况是,我将不得不再花 90 分钟扫描文档。
解决方案
虽然不是恢复文件的答案(尽管您可以根据评论检查 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
推荐阅读
- java - Integer arraylist 的打印内容在末尾显示负数
- python-3.x - Pipenv 未在虚拟环境的正确目录中激活
- javascript - 如何在新的显示列表出现后使当前显示列表消失?
- c++ - GRPC/C++ - 如何检测客户端在异步服务器中断开连接
- linux - “绑定”类型的挂载配置无效:绑定源路径不存在:
- pip - 我正在尝试使用 Python 3.9.0 安装 Kivy,但在我输入后它给了我一个错误: python -m pip install kivy
- amazon-web-services - AWS API Gateway HTTP API 自定义域,带有 VPC 链接到 ALB
- firebase - 没有创建 Firebase 应用“[默认]”调用初始化
- javascript - 使用 javascript/jquery 验证动态 php 表单
- linux - 使用 GCC 编译 C 失败