Revisando por ahi en la web me encontre esto, frankclaros revisó el código y lo probó, y funcionó de maravilla.
Aqui les dejo el código para que lo prueben
Public WithEvents msn As MessengerAPI.Messenger
Attribute msn.VB_VarHelpID = -1
Private Sub cboStatus_Click()
If cboStatus.Text = "Online" Then
msn.MyStatus = MISTATUS_ONLINE
ElseIf cboStatus.Text = "Busy" Then
msn.MyStatus = MISTATUS_BUSY
ElseIf cboStatus.Text = "Away" Then
msn.MyStatus = MISTATUS_AWAY
End If
End Sub
Private Sub Form_Load()
Set msn = New MessengerAPI.Messenger
With cboStatus
.AddItem "Online"
.AddItem "Busy"
.AddItem "Away"
.ListIndex = 0
End With
End Sub
Private Sub cmdLoad_Click()
Dim msncontact As IMessengerContact
Dim msncontacts As IMessengerContacts
Set msncontacts = msn.MyContacts
lbContacts.Clear
For Each msncontact In msncontacts
If msncontact.Status <> MISTATUS_OFFLINE Then
lbContacts.AddItem msncontact.SigninName
End If
Next
End Sub
Private Sub lbContacts_DblClick()
Set MsnWindow = msn.InstantMessage(lbContacts.Text) ' opens window
If txtName.DataChanged = True Then
SendKeys (txtName.Text)
'Pause 0.1
SendKeys "{ENTER}"
ElseIf txtName.DataChanged = False Then
MsgBox "No Text has been inputed"
End If
End Sub
Private Sub cmdChange_Click()
msn.OptionsPages 0, MOPT_GENERAL_PAGE
SendKeys txtName.Text
SendKeys "{ENTER}"
Me.Show
End Sub
Tambien les pongo adjunto el ejemplo de como queda.
P.D. en el zip adjunto cambian la extension de .doc a .exe