bonjour
vous trouverez ci joint quelques exemples pour piloter MSN Messenger et Windows Messenger depuis Excel
exemples testés avec Windows XP , Excel2002 , Windows Messenger 4.7 et MSN Messenger 7.5
la source utilisée : Ce lien n'existe plus
Cette 1ere partie présente des procédures qui fonctionnent avec les 2 applications
----------------------------------------------------------------------------------------------
Vérifier si une session est ouverte
Sub verifierConnectionSession_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim objMessenger As MessengerAPI.Messenger
Set objMessenger = New MessengerAPI.Messenger
If objMessenger.MyStatus = MISTATUS_OFFLINE Or MISTATUS_UNKNOWN Then
MsgBox 'non connecté'
Else
MsgBox 'connecté'
End If
End Sub
Fermer la session
Sub fermerSession_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
Msn.Signout
End Sub
Afficher le nombre de contacts
Sub nombreContacts_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contacts As IMessengerContacts
Set Msn = New MessengerAPI.Messenger
Set Contacts = Msn.MyContacts
MsgBox Contacts.Count
End Sub
Boucler sur l'ensemble des contacts et afficher des informations sur chacun d'entre eux
Sub listeEtInformationsContacts_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contacts As MessengerAPI.IMessengerContacts
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contacts = Msn.MyContacts
For Each Contact In Contacts
Debug.Print Contact.SigninName
Debug.Print Contact.Status
Debug.Print Contact.FriendlyName
Next
End Sub
Ajouter un contact
Sub ajoutContact_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
'pour Windows messenger ,la creation est effectee automatiquement
'pour MSN messenger ,la procedure affiche la boite de dialogue de creation
Dim objMessenger As MessengerAPI.Messenger
Set objMessenger = New MessengerAPI.Messenger
objMessenger.AddContact 0, 'nouveauContact@hotmail.fr'
End Sub
Supprimer un contact
Sub supprimerContact_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contacts As MessengerAPI.IMessengerContacts
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contacts = Msn.MyContacts
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Contacts.Remove Contact
End Sub
Afficher des informations sur un contact spécifique
Sub informationsContactSpecifique_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Debug.Print Contact.SigninName
Debug.Print Contact.Status
Debug.Print Contact.FriendlyName
End Sub
Bloquer ou débloquer un contact
Sub bloquerUnContact_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Contact.Blocked = True
'et pour le débloquer
'Contact.Blocked = False
End Sub
Cette 2eme partie présente des procédures spécifiques à MSN Messenger
---------------------------------------------------------------------------------------
Afficher la boite de dialoque pour se connecter
Sub afficherBoiteDialogue_ouvertureSession_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
Msn.Signin 0, 'monProfil@hotmail.fr', 'password'
'
'si vous avez paramétré automatiquement le profil et le mot de passe:
'Msn.AutoSignin
End Sub
Compter le nombre de messages contenus dans la boite de réception
Sub nombreMessagesBoiteReception_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
MsgBox Msn.UnreadEmailCount(MUAFOLDER_INBOX)
End Sub
Afficher quelques informations sur mon profil
Sub informations_monProfil_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
Debug.Print Msn.MyFriendlyName
Debug.Print Msn.MyPhoneNumber(MPHONE_TYPE_MOBILE)
Debug.Print Msn.MyPhoneNumber(MPHONE_TYPE_WORK)
Debug.Print Msn.MyPhoneNumber(MPHONE_TYPE_HOME)
Debug.Print Msn.MySigninName
Debug.Print Msn.MyStatus
Debug.Print Msn.MyServiceId
Debug.Print Msn.MyServiceName
End Sub
Afficher la page de creation d'un mail
Sub pageEnvoiMail_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.fr', Msn.MyServiceId)
Msn.SendMail Contact
End Sub
Afficher la fenetre d'envoi de message instantané
Sub fenetreEnvoiMessageInstantane_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Msn.InstantMessage Contact
End Sub
Cette 3eme partie présente des procédures spécifiques à Windows Messenger
---------------------------------------------------------------------------------------
Envoyer un message
Sub envoiMessage_WINDOWS_MESSENGER()
'necessite d'activer la reference 'Messenger 1.0 Type Library'
Dim objImsg As Messenger.MsgrObject
Dim Contact As Messenger.IMsgrUser2
Dim imHeader As String
imHeader = 'Mime-Version: 1.0' & vbCrLf & _
'Content-Type: text/plain; charset=UTF-8' & vbCrLf & vbCrLf
Set objImsg = New Messenger.MsgrObject
Set Contact = _
objImsg.CreateUser('leProfil@hotmail.com', objImsg.Services.PrimaryService)
Contact.SendText imHeader, 'Bonjour , comment allez vous ?', MMSGTYPE_NO_RESULT
End Sub
Boucler sur l'ensemble des contacts et afficher des informations sur chacun d'entre eux
Sub listeContacts_WINDOWS_MESSENGER()
'necessite d'activer la reference 'Messenger 1.0 Type Library'
Dim Contact As Messenger.IMsgrUser
Dim X As New Messenger.MsgrObject
For Each Contact In X.List(0)
Debug.Print Contact.LogonName
Debug.Print Contact.EmailAddress
Debug.Print Contact.FriendlyName
Debug.Print Contact.State
Next Contact
End Sub
Modifier votre statut de connection
Sub modifierStatutConnection_WINDOWS_MESSENGER()
'necessite d'activer la reference 'Messenger 1.0 Type Library'
Dim Msn As MsgrObject
Set Msn = New MsgrObject
'Msn.LocalState = MSTATE_INVISIBLE 'hors connection
Msn.LocalState = MSTATE_AWAY 'Absent
'Msn.LocalState = MSTATE_ONLINE 'en ligne
'Msn.LocalState = MSTATE_BUSY 'occupé
'Msn.LocalState = MSTATE_BE_RIGHT_BACK 'de retour dans une minute
'Msn.LocalState = MSTATE_AWAY 'absent
'Msn.LocalState = MSTATE_ON_THE_PHONE 'au téléphone
'Msn.LocalState = MSTATE_OUT_TO_LUNCH 'parti manger
End Sub
bonne soiree
MichelXld
Message édité par: michelxld, à: 29/09/2005 17:57
vous trouverez ci joint quelques exemples pour piloter MSN Messenger et Windows Messenger depuis Excel
exemples testés avec Windows XP , Excel2002 , Windows Messenger 4.7 et MSN Messenger 7.5
la source utilisée : Ce lien n'existe plus
Cette 1ere partie présente des procédures qui fonctionnent avec les 2 applications
----------------------------------------------------------------------------------------------
Vérifier si une session est ouverte
Sub verifierConnectionSession_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim objMessenger As MessengerAPI.Messenger
Set objMessenger = New MessengerAPI.Messenger
If objMessenger.MyStatus = MISTATUS_OFFLINE Or MISTATUS_UNKNOWN Then
MsgBox 'non connecté'
Else
MsgBox 'connecté'
End If
End Sub
Fermer la session
Sub fermerSession_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
Msn.Signout
End Sub
Afficher le nombre de contacts
Sub nombreContacts_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contacts As IMessengerContacts
Set Msn = New MessengerAPI.Messenger
Set Contacts = Msn.MyContacts
MsgBox Contacts.Count
End Sub
Boucler sur l'ensemble des contacts et afficher des informations sur chacun d'entre eux
Sub listeEtInformationsContacts_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contacts As MessengerAPI.IMessengerContacts
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contacts = Msn.MyContacts
For Each Contact In Contacts
Debug.Print Contact.SigninName
Debug.Print Contact.Status
Debug.Print Contact.FriendlyName
Next
End Sub
Ajouter un contact
Sub ajoutContact_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
'pour Windows messenger ,la creation est effectee automatiquement
'pour MSN messenger ,la procedure affiche la boite de dialogue de creation
Dim objMessenger As MessengerAPI.Messenger
Set objMessenger = New MessengerAPI.Messenger
objMessenger.AddContact 0, 'nouveauContact@hotmail.fr'
End Sub
Supprimer un contact
Sub supprimerContact_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contacts As MessengerAPI.IMessengerContacts
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contacts = Msn.MyContacts
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Contacts.Remove Contact
End Sub
Afficher des informations sur un contact spécifique
Sub informationsContactSpecifique_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Debug.Print Contact.SigninName
Debug.Print Contact.Status
Debug.Print Contact.FriendlyName
End Sub
Bloquer ou débloquer un contact
Sub bloquerUnContact_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Contact.Blocked = True
'et pour le débloquer
'Contact.Blocked = False
End Sub
Cette 2eme partie présente des procédures spécifiques à MSN Messenger
---------------------------------------------------------------------------------------
Afficher la boite de dialoque pour se connecter
Sub afficherBoiteDialogue_ouvertureSession_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
Msn.Signin 0, 'monProfil@hotmail.fr', 'password'
'
'si vous avez paramétré automatiquement le profil et le mot de passe:
'Msn.AutoSignin
End Sub
Compter le nombre de messages contenus dans la boite de réception
Sub nombreMessagesBoiteReception_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
MsgBox Msn.UnreadEmailCount(MUAFOLDER_INBOX)
End Sub
Afficher quelques informations sur mon profil
Sub informations_monProfil_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Set Msn = New MessengerAPI.Messenger
Debug.Print Msn.MyFriendlyName
Debug.Print Msn.MyPhoneNumber(MPHONE_TYPE_MOBILE)
Debug.Print Msn.MyPhoneNumber(MPHONE_TYPE_WORK)
Debug.Print Msn.MyPhoneNumber(MPHONE_TYPE_HOME)
Debug.Print Msn.MySigninName
Debug.Print Msn.MyStatus
Debug.Print Msn.MyServiceId
Debug.Print Msn.MyServiceName
End Sub
Afficher la page de creation d'un mail
Sub pageEnvoiMail_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.fr', Msn.MyServiceId)
Msn.SendMail Contact
End Sub
Afficher la fenetre d'envoi de message instantané
Sub fenetreEnvoiMessageInstantane_MSN_MESSENGER()
'necessite d'activer la reference 'Messenger API Type Library'
Dim Msn As MessengerAPI.Messenger
Dim Contact As MessengerAPI.IMessengerContact
Set Msn = New MessengerAPI.Messenger
Set Contact = Msn.GetContact('leProfil@hotmail.com', Msn.MyServiceId)
Msn.InstantMessage Contact
End Sub
Cette 3eme partie présente des procédures spécifiques à Windows Messenger
---------------------------------------------------------------------------------------
Envoyer un message
Sub envoiMessage_WINDOWS_MESSENGER()
'necessite d'activer la reference 'Messenger 1.0 Type Library'
Dim objImsg As Messenger.MsgrObject
Dim Contact As Messenger.IMsgrUser2
Dim imHeader As String
imHeader = 'Mime-Version: 1.0' & vbCrLf & _
'Content-Type: text/plain; charset=UTF-8' & vbCrLf & vbCrLf
Set objImsg = New Messenger.MsgrObject
Set Contact = _
objImsg.CreateUser('leProfil@hotmail.com', objImsg.Services.PrimaryService)
Contact.SendText imHeader, 'Bonjour , comment allez vous ?', MMSGTYPE_NO_RESULT
End Sub
Boucler sur l'ensemble des contacts et afficher des informations sur chacun d'entre eux
Sub listeContacts_WINDOWS_MESSENGER()
'necessite d'activer la reference 'Messenger 1.0 Type Library'
Dim Contact As Messenger.IMsgrUser
Dim X As New Messenger.MsgrObject
For Each Contact In X.List(0)
Debug.Print Contact.LogonName
Debug.Print Contact.EmailAddress
Debug.Print Contact.FriendlyName
Debug.Print Contact.State
Next Contact
End Sub
Modifier votre statut de connection
Sub modifierStatutConnection_WINDOWS_MESSENGER()
'necessite d'activer la reference 'Messenger 1.0 Type Library'
Dim Msn As MsgrObject
Set Msn = New MsgrObject
'Msn.LocalState = MSTATE_INVISIBLE 'hors connection
Msn.LocalState = MSTATE_AWAY 'Absent
'Msn.LocalState = MSTATE_ONLINE 'en ligne
'Msn.LocalState = MSTATE_BUSY 'occupé
'Msn.LocalState = MSTATE_BE_RIGHT_BACK 'de retour dans une minute
'Msn.LocalState = MSTATE_AWAY 'absent
'Msn.LocalState = MSTATE_ON_THE_PHONE 'au téléphone
'Msn.LocalState = MSTATE_OUT_TO_LUNCH 'parti manger
End Sub
bonne soiree
MichelXld
Message édité par: michelxld, à: 29/09/2005 17:57