VBA - Outlook 不删除附件

VBA 自动处理 Outlook 邮件附件

vba
Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Dim objFSO As Object
    Dim objFolder As Object
    Dim strFolderPath As String
    ' 设置保存附件的文件夹路径
    strFolderPath = "C:\Attachments"
    ' 创建一个 Outlook 应用对象
    Set objOL = Outlook.Application
    ' 获取当前选中的邮件
    Set objMsg = objOL.ActiveExplorer.Selection.Item(1)
    ' 获取邮件中的附件集合
    Set objAttachments = objMsg.Attachments
    ' 检查是否有附件
    If objAttachments.Count > 0 Then
        ' 创建一个文件系统对象
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        ' 检查保存附件的文件夹是否存在，不存在则创建
        If Not objFSO.FolderExists(strFolderPath) Then
            objFSO.CreateFolder strFolderPath
        End If
        ' 保存每个附件
        For Each objAttachment In objAttachments
            objAttachment.SaveAsFile strFolderPath & "\" & objAttachment.FileName
        Next objAttachment
    End If
    ' 清除对象
    Set objAttachment = Nothing
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objOL = Nothing
    MsgBox "附件已保存至：" & strFolderPath
End Sub