Dim m_MSG As New MessengerAPI.Messenger 'MSN的Com对象
Dim m_Groups As MessengerAPI.IMessengerGroups 'MSN中的分组
Dim m_Group As MessengerAPI.IMessengerGroup 'MSN中组的内容
Dim m_Contracts As MessengerAPI.IMessengerContacts 'MSN中的所有的好友的信息
Dim m_Contract As MessengerAPI.IMessengerContact 'MSN中每个好友对象的内容Private Sub Command1_Click()  Dim i As Integer
  '检测需要发送的信息是否合法
  If Trim(Text1.Text) = "" Then
    MsgBox "发送的信息不能为空!", vbInformation, "提示"
    Text1.SetFocus
    Exit Sub
  End If
  '判断消息的发送对象是全部好友还是某个组的成员  If Combo1.ListIndex = 0 Then
    Set m_Contracts = m_MSG.MyContacts
  Else
    Set m_Groups = m_MSG.MyGroups
    Set m_Group = m_Groups.Item(Combo1.ListIndex - 1)
    Set m_Contracts = m_Group.Contacts
  End If'遍历要发送的对象,发送信息  For i = 0 To m_Contracts.Count - 1
    Set m_Contract = m_Contracts.Item(i)
    If Check1.Value = 1 Then
      If m_Contract.Status = 2 Then
        m_MSG.InstantMessage m_Contract '打开要发送的好友窗体
        DoEvents
        SendKeys Text1.Text '写入信息
        DoEvents
        SendKeys "{enter}" '发送出信息
        DoEvents
        SendKeys "%{F4}" '关闭好友窗口
      End If
    Else
      m_MSG.InstantMessage m_Contract
      DoEvents
      SendKeys Text1.Text
      DoEvents
      SendKeys "{enter}"
      DoEvents
      SendKeys "%{F4}"
    End If
  Next i
  '成功发送完毕信息
  If MsgBox("发送完毕!是否清空消息?", vbInformation + vbYesNo, "提示") = vbYes Then
    Text1.Text = ""
    Text1.SetFocus
  Else
    Text1.SetFocus
  End If
End SubPrivate Sub Command2_Click()
  Unload Me
  EndEnd Sub'初始化控件Private Sub Form_Load()
  Dim i As Integer
  '初始化发送对象的下拉框
  Set m_Groups = m_MSG.MyGroups
  With Combo1
    .AddItem "全部的组"
    For i = 0 To m_Groups.Count - 1
      Set m_Group = m_Groups.Item(i)
      .AddItem m_Group.Name
    Next i
    .ListIndex = 0
  End With
  Text1.Text = ""
End Sub'释放变量Private Sub Form_Unload(Cancel As Integer)
  Set m_MSG = Nothing
  Set m_Groups = Nothing
  Set m_Group = Nothing
  Set m_Contracts = Nothing
  Set m_Contract = Nothing
End Sub