Send instant message on Office Communicator using Excel VBA - vba

Question

I want to send instant message using Office Communicator and Excel VBA. I use an excel sheet containing a list of Email IDs.
**A B C**
Serial No Name Email
1 abc abc.abc#abc.com
2 xyz xyz.xyz#xyz.com
3 pqr pqr.pqr#pqr.com
I wrote the below code to send message. But it is not working. I have enabled Communicator reference in VBA.
Sub sendIM()
Dim msgr As CommunicatorAPI.IMessengerConversationWndAdvanced
Dim ToUser As String
Dim message As String
Application.ScreenUpdating = True
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
On Error Resume Next
If cell.Value Like "?*#?*.?*" Then
ToUser = Chr(34) & cell.Value & Chr(34)
'MsgBox ToUser
message = "Hi " & Cells(cell.Row, "B").Value _
& vbNewLine & vbNewLine & _
"HOW ARE YOU"
Set msgr = Messenger.InstantMessage(ToUser)
msgr.SendText (message)
End If
Next cell
Application.ScreenUpdating = True
End Sub
For a single email id, it is working. I use the below mentioned code to send single message.
Sub sendIM()
Dim msgr As CommunicatorAPI.IMessengerConversationWndAdvanced
Dim ToUser As String
Dim message As String
Application.ScreenUpdating = True
ToUser = "abc.abc#abc.com"
message = "hai"
On Error Resume Next
Set msgr = Messenger.InstantMessage(ToUser)
msgr.SendText (message)
Application.ScreenUpdating = True
End Sub
But I need to loop through the sheet so that the message is sending to everyone. What changes I have to make this work ?
Note: The Email Ids here I mentioned is not real.

Answer 1

I have never worked with Office Communicator but since you are saying that the second code works then try this. (UNTESTED)
Sub SendIM()
Dim msgr As CommunicatorAPI.IMessengerConversationWndAdvanced
Dim ToUser As String, message As String
Dim aCell As Range
Dim ws As Worksheet
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
With ws
'~~> Why On Error Resume next? If you know what error you are going to get
'~~> Then simply handle it. For the time being, I am skipping the record
'~~> Also keeping it out of the loop
On Error GoTo SkipIT
For Each aCell In .Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If aCell.Value Like "?*#?*.?*" Then
ToUser = aCell.Value '<~~ Don't need quotes
message = "Hi " & .Cells(aCell.Row, "B").Value _
& vbNewLine & vbNewLine & _
"HOW ARE YOU"
Set msgr = Messenger.InstantMessage(ToUser)
msgr.SendText (message)
DoEvents '<~~ Let excel send the message. Give it time
End If
SkipIT:
Next aCell
End With
Application.ScreenUpdating = True
End Sub
EDIT
An improved version. Takes care of error handling
Sub sendIM()
Dim msgr As CommunicatorAPI.IMessengerConversationWndAdvanced
Dim ToUser As String, message As String
Dim aCell As Range
Dim ws As Worksheet
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
With ws
For Each aCell In .Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If aCell.Value Like "?*#?*.?*" Then
ToUser = aCell.Value '<~~ Don't need quotes
message = "Hi " & .Cells(aCell.Row, "B").Value _
& vbNewLine & vbNewLine & _
"HOW ARE YOU"
'~~> Only place I can think an error could happen
On Error Resume Next
Set msgr = Messenger.InstantMessage(ToUser)
'~~> Check if the object is created
If Not msgr Is Nothing Then msgr.SendText (message)
Set msgr = Nothing
On Error GoTo 0
DoEvents '<~~ Let excel send the message. Give it time
End If
Next aCell
End With
Application.ScreenUpdating = True
End Sub