GPT自用代码——下载附件

Sub SaveAttachmentsBySubject()

    Dim objItem As Object

    Dim objMail As Outlook.MailItem

    Dim objAttach As Outlook.Attachment

    Dim saveFolder As String

    Dim i As Integer

    

    ' 选择保存附件的文件夹路径

    saveFolder = "C:\"

    

    For Each objItem In ActiveExplorer.Selection

        If objItem.Class = olMail Then

            Set objMail = objItem

            

            ' 为此电子邮件创建文件夹并更改FolderPath以查找此文件夹。 

            FName = objMail.ConversationTopic

            

            ' 删除非法字符

            For i = 1 To Len(FName)

                c = Mid(FName, i, 1)

        

                Select Case c

                    Case Is = "/"

                        Mid(FName, i) = "."

                    Case Is = "\", "|", "?", "<", ">", ":", "*", """"

                        Mid(FName, i) = ""

                End Select

            Next i

        

            If Len(Dir(saveFolder & "\" & FName, vbDirectory)) = 0 Then

                MkDir (saveFolder & "\" & FName)

            End If

        

            ' 循环遍历所有附件

            For Each objAttach In objMail.Attachments

            

                ' 将附件另存为指定的文件夹下

                objAttach.SaveAsFile saveFolder & "\" & FName & "\" & objAttach.FileName

            

            Next objAttach

        Else

            MsgBox "请选择一封电子邮件。"

        End If

        

    Next

End Sub