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
« 制限付きサイトの汎用Mark Of The Web(MOTW)は? | トップページ | HTAやHTML、Excel VBAなどでWScript.ShellのPopup(時間指定)を使う。 »