怎么批量提取eml文件中的附件？

新建txt，粘贴以下内容，保存修改后缀为vbs

Dim objCDO, objMessage, objAtt, strPath, strAttPath, myReg
Set myReg=WScript.CreateObject("WScript.Shell")
strPath = myReg.CurrentDirectory & "\"
strAttPath = strPath
Set objCDO = CreateObject("CDO.DropDirectory")
    For Each objMessage In objCDO.GetMessages(strPath)
        For Each objAtt In objMessage.Attachments
            objAtt.SaveToFile strAttPath & objAtt.Filename
        Next
    Next
Set objCDO = Nothing
Set objMessage = Nothing
Set objAtt = Nothing
Set myReg= nothing
Msgbox "Ok, 附件存放在 " & strPath

可放在同目录下运行。

引自excelhome论坛， kangatang 大佬。