Sub MailText()

'
' MailText macro, by Ben Jones (http://welcome.to/BJTranslations)
' Converts forms posted by mail from websites into readable text
' Includes conversion of %xx codes into 8-bit (Japanese) text
' Usage: open form (e.g. Postdata.att) in Word then run
'

Dim Char1, Char2, SaveOptions
Char1 = 33000: Char2 = 33000: SaveOptions = Options.SmartCutPaste

Options.SmartCutPaste = False
'otherwise extra spaces mean wrong characters get selected

WordBasic.EditReplace Find:="&", Replace:="^p", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=1
WordBasic.EditReplace Find:="+", Replace:=" ", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=1
WordBasic.EditReplace Find:="=", Replace:=" = ", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=1

Do
Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "%"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .MatchByte = False
        .MatchFuzzy = True
    End With
    If Not Selection.Find.Execute Then Exit Do
    Selection.Delete
    Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Char1 = Val("&H" + Selection) * 256
    Selection.Delete
    
    If Char1 < 32768 Then   'i.e. not first half of DBCS character
    Selection = Chr(Char1)
    Else
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        If Selection = "%" Then
            Selection.Delete
            Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
            Char2 = Val("&H" + Selection)
        Else
            Char2 = Asc(Selection)
        End If
        Selection = Chr(Char1 + Char2)
    End If
Loop

Options.SmartCutPaste = SaveOptions
End Sub