MHTMLファイルを分解する。

MHTMLファイル「ほげ.mht」を分解して、フォルダ「ほげ」の下に展開します。
ファイル名は、第一階層番号[.第二階層番号[...]].txt です。
ファイル名とURLの対応関係を index.htm に書き出します。

ExpandMHTML.vbs MHTMLファイル...

Option Explicit
Dim fso
Dim Path
Dim FolderName
Set fso=CreateObject("Scripting.FileSystemObject")
For Each Path In WScript.Arguments
  FolderName=fso.BuildPath(fso.GetParentFolderName(Path),fso.GetBaseName(Path))
  If fso.FolderExists(FolderName) Then
    For k=2 To 9
      If Not fso.FolderExists(FolderName & " " & k) Then Exit For
    Next
    FolderName=FolderName & " " & k
  End If
  fso.CreateFolder FolderName
  Call Expand(Path,FolderName)
Next

Sub Expand(Path,Folder)
Dim Stm
Dim Msg
Dim File
Set Stm=CreateObject("ADODB.Stream")
Stm.Open
Stm.LoadFromFile Path
set Msg=createobject("CDO.Message")
Msg.DataSource.OpenObject Stm, "_Stream"
Set File=fso.CreateTextFile(Folder & "\index.html")
File.WriteLine "<table border><thead><td>File</td><td>Content-Type</td><td>Content-Location</td></thead><tbody>"
Call SaveToFile(Msg.BodyPart,"1",Folder,File)
File.WriteLine "</tbody></table>"
File.Close
End Sub

Sub SaveToFile(BodyPart,BaseName,Folder,File)
Dim k
If BodyPart.BodyParts.Count Then
  For k=1 To BodyPart.BodyParts.Count
    Call SaveToFile(BodyPart.BodyParts.Item(k),BaseName & "." & k,Folder,File)
  Next
Else
  File.WriteLine "<tr><td>" & BaseName & "</td><td>" & BodyPart.Fields.Item("urn:schemas:mailheader:content-type") & "</td><td>" &  fso.GetFileName(BodyPart.Fields.Item("urn:schemas:mailheader:content-location")) & "</td><td>" & BodyPart.Fields.Item("urn:schemas:mailheader:content-location") & "</td></tr>"
  BodyPart.SaveToFile Folder & "\" & BaseName & ".txt"
End If
End Sub