使用excel vba子目录从保存在文件夹中的.msg文件中提取附件

Sub ExtractAttachmentsFromMsgFiles()
    Dim folderPath As String
    Dim msgFile As String
    Dim outlookApp As Object
    Dim outlookNamespace As Object
    Dim outlookMailItem As Object
    Dim outlookAttachment As Object
    Dim saveFolder As String
    
    ' 设置文件夹路径
    folderPath = "C:\YourFolderPath\"
    
    ' 创建Outlook应用程序对象
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    
    ' 循环遍历文件夹中的.msg文件
    msgFile = Dir(folderPath & "*.msg")
    Do While msgFile <> ""
        ' 打开.msg文件
        Set outlookMailItem = outlookApp.CreateItemFromTemplate(folderPath & msgFile)
        
        ' 设置保存附件的文件夹路径
        saveFolder = "C:\YourSaveFolderPath\" & Left(msgFile, Len(msgFile) - 4) & "\"
        
        ' 创建保存附件的文件夹
        If Dir(saveFolder, vbDirectory) = "" Then
            MkDir saveFolder
        End If
        
        ' 提取附件
        For Each outlookAttachment In outlookMailItem.Attachments
            outlookAttachment.SaveAsFile saveFolder & outlookAttachment.FileName
        Next outlookAttachment
        
        ' 关闭.msg文件
        outlookMailItem.Close olDiscard
        
        ' 继续下一个.msg文件
        msgFile = Dir
    Loop
    
    ' 释放对象
    Set outlookAttachment = Nothing
    Set outlookMailItem = Nothing
    Set outlookNamespace = Nothing
    Set outlookApp = Nothing
    
    MsgBox "附件提取完成！"
End Sub