'◆◆◆必要な象物を取得する
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WinHost = CreateObject("WScript.Shell")
    Set MSOL = CreateObject("outlook.application")
    Set sarashugo = MSOL.Session.Folders(1).Folders
'◆◆◆皿名選択の窓を出し、指定されたデータ帳を開く
    hyodai = "皿の選択"
    setumei = "変換する皿を対応する数で指定して下さい" & vbNewLine
    For jj = 1 To sarashugo.Count
        setumei = setumei & vbNewLine & jj & "―― " & sarashugo(jj)
        if sarashugo(jj) = "受信ﾄﾚｲ" then sarabandef = jj
    Next
    saraban = InputBox(setumei, hyodai, sarabandef)
    If saraban = "" Then WScript.Quit
    If saraban = 0 Then WScript.Quit
    saraban = CInt(saraban)
    Set sara = sarashugo(saraban)
'    sara.Display  '■■■変換元の皿を表示する
    keiro = "C:\手紙\" '●●●メールを変換したtxtの保存先
    fukuro = Left(keiro, Len(keiro) - 1)
    If Not FSO.FolderExists(fukuro) Then
        WinHost.Run ("command /c md " & fukuro), 3, True
'        WinHost.Run ("cmd /c md " & fukuro), 3, True '◆◆◆winXP用
    End If

    kosu = sara.Items.Count
    For lll = 1 To kosu
        Set komoku = sara.Items(kosu - lll + 1)
        tien = Timer: Do While Timer < tien + 0.1: Loop
        
        sasidasinin = komoku.SenderName
        atesaki = komoku.To
        CC = komoku.CC
        kenmei = komoku.Subject
        nitizi = komoku.ReceivedTime
        baito = komoku.Size & "バイト"
        hombun = komoku.Body
        On Error Resume Next
            zyusyo = ""
            Set hensin = komoku.Reply
            zyusyo = hensin.To
            If zyusyo <> sasidasinin And zyusyo <> "" Then
                sasidasinin = sasidasinin & " [" & zyusyo & "]"
            End If
            Set hensin = Nothing
        On Error GoTo 0
        kenmei2 = chomeizenkaku(kenmei)
        kenmei2 = Left(kenmei2, 100)
        nitizi2 = nitizihenkan(nitizi)

        kiroku = keiro & nitizi2 & "＝" & kenmei2 & Timer * 100 & ".txt"
        Set cho = FSO.CreateTextFile(kiroku)
            cho.WriteLine ("差出人:" & vbTab & sasidasinin)
            cho.WriteLine ("宛て先:" & vbTab & atesaki)
            cho.WriteLine ("ＣＣ:" & vbTab & CC)
            cho.WriteLine ("件名:" & vbTab & kenmei)
            cho.WriteLine ("受信日時:" & vbTab & nitizi)
            cho.WriteLine ("サイズ:" & vbTab & baito)
            cho.WriteLine ("")
            cho.WriteLine ("▼▼▼▼▼▼▼▼▼▼▼▼▼以下本文▼▼▼▼▼▼▼▼▼▼▼▼▼")
            cho.WriteLine (hombun)
            cho.WriteLine ("▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲")
        cho.Close 
'        If lll <= 5 Then WinHost.Run """" & kiroku & """" '★★★最大5件のtxtを開く
        komoku.Delete '◆◆◆手紙をゴミ皿に移す（ゴミ皿からの変換では手紙を削除する）
    Next

    Set winshell = CreateObject("Shell.Application")
    winshell.Explore keiro
    MsgBox "『" & sara & "』の手紙 " & kosu & " 件を変換しました。"

Function nitizihenkan(ima)
    tosi = Right(Year(ima), 2)
    tuki = Month(ima)
    tuki = String(2 - Len(tuki), "0") & tuki
    hi = Day(ima)
    hi = String(2 - Len(hi), "0") & hi
    toki = Hour(ima)
    toki = String(2 - Len(toki), "0") & toki
    fun = Minute(ima)
    fun = String(2 - Len(fun), "0") & fun
    nitizihenkan = tosi & "_" & tuki & "_" & hi & " " & toki & "：" & fun
End Function
Function chomeizenkaku(moji)
    kekka = ""
    For kk = 1 To Len(moji)
        itizi = Mid(moji, kk, 1)
        If itizi = Chr(&HFF) Then
        ElseIf itizi = Chr(&HFE) Then
        ElseIf itizi = Chr(&HFD) Then
        Else
            kekka = kekka & itizihenkan(itizi)
        End If
    Next
    chomeizenkaku = kekka
End Function
Function itizihenkan(itizi)
    Dim kinsikode(14)
    kinsikode(0) = 34    'Chr(34)＝"――Asc(")＝34
    kinsikode(1) = 42    'Chr(42)＝*――Asc(*)＝42
    kinsikode(2) = 47    'Chr(47)＝/――Asc(/)＝47
    kinsikode(3) = 58    'Chr(58)＝:――Asc(:)＝58
    kinsikode(4) = 60    'Chr(60)＝<――Asc(<)＝60
    kinsikode(5) = 62    'Chr(62)＝>――Asc(>)＝62
    kinsikode(6) = 63    'Chr(63)＝?――Asc(?)＝63
    kinsikode(7) = 92    'Chr(92)＝\――Asc(\)＝92
    kinsikode(8) = 124   'Chr(124)＝|――Asc(|)＝124

'◆◆◆念のために、更に6件の全角変換を追加した
    kinsikode(9) = 35   'Chr(35)＝#――Asc(#)＝35
    kinsikode(10) = 44    'Chr(44)＝,――Asc(,)＝44
    kinsikode(11) = 46   'Chr(46)＝.――Asc(.)＝46
    kinsikode(12) = 59   'Chr(59)＝;――Asc(;)＝59
    kinsikode(13) = 91   'Chr(91)＝[――Asc([)＝91
    kinsikode(14) = 93   'Chr(93)＝]――Asc(])＝93

'◆◆◆以上15件を全角変換する
    SJIS = Asc(itizi)
    kinsi = False
    For kk = 0 To UBound(kinsikode)
        If SJIS = kinsikode(kk) Then kinsi = True: Exit For
    Next
    If kinsi = True Then
        If SJIS = 92 Then
            kodo2 = -27
        Else
            kodo2 = SJIS - 288
        End If
        itizihenkan = ChrW(kodo2)
    Else
      '◆◆◆その他の禁止文字はChrW(-196)＝＼にする
        If SJIS > -1 And SJIS < 32 Then
          itizihenkan = ChrW(-196)
        ElseIf SJIS = 128 Then
          itizihenkan = ChrW(-196)
        ElseIf SJIS > 252 And SJIS < 256 Then
          itizihenkan = ChrW(-196)
        Else
          itizihenkan = itizi
        End If
    End If
End Function