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

Question

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

**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

我写了下面的代码来发送消息。但它没有用。我在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 = "abc.abc@abc.com"
message = "hai"
On Error Resume Next
Set msgr = Messenger.InstantMessage(ToUser)
msgr.SendText (message)
Application.ScreenUpdating = True
End Sub

但是我需要遍历表单，以便将消息发送给每个人。我需要做些什么改变呢？

注意：我提到的电子邮件ID不是真实的。

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

修改

改进版。负责错误处理

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