使用Excel VBA在Office Communicator上发送即时消息

我想使用Office Communicator和Excel VBA发送即时消息。 我使用包含电子邮件ID列表的Excel工作表。

**ABC** Serial No Name Email 1 abc [e-mail] 2 xyz [e-mail] 3 pqr [e-mail] 

我写了下面的代码发送消息。 但它不工作。 我在VBA中启用了Communicator参考。

 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 

对于一个电子邮件ID，它正在工作。 我使用下面提到的代码发送单个消息。

 Sub sendIM() Dim msgr As CommunicatorAPI.IMessengerConversationWndAdvanced Dim ToUser As String Dim message As String Application.ScreenUpdating = True ToUser = "[e-mail]" message = "hai" On Error Resume Next Set msgr = Messenger.InstantMessage(ToUser) msgr.SendText (message) Application.ScreenUpdating = True End Sub 

但是我需要循环查看表单，以便将消息发送给每个人。 我必须做出什么改变才能做到这一点？

注意：这里我提到的电子邮件地址不是真实的。

Answer 1

我从来没有使用过Office Communicator但是由于您是说第二个代码可以正常工作，请试试这个。 （ 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 

编辑

一个改进的版本。 照顾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