IM Distribution list Auto response Bot - Use Exchange DL's in IM

Introduction             download code

The following piece of code is to allow you to use your Exchange Distribution lists from an IM client to send out an instant message to all users in an Exchange DL that have an Instant messaging address. It is a functional IM response bot that takes the first line of an Instant message as the name of the Distribution list you want to send to . It then performs an Active directory query to find this DL in active directory and goes through the members of the DL and sends them the Instant message which comprises of the rest of the original message that was sent to the Auto response bot.

How it works

The code works similarly to what's described in my IM bot introduction article please see this for a description of the front end of this code. You will need to customise these parts of the code with your own connection settings and IM user details

Public WithEvents oIMServ As MSIMCliSDKLib.MSIMService
Public WithEvents oIMApp As MSIMCliSDKLib.MSIMHost


Private Sub Form_Load()
On Error Resume Next   'Don't stop execution, continue on next line
Set oIMApp = CreateObject("MSExchangeIM.MSIMHost")
Set oIMServ = oIMApp.CreateContext("Default", 0)
strtest = Array("IMaddress", "username", "password", "domain")
oIMServ.Logon strtest

End Sub

The next part of the code is the one that matters which is the OnTextRecieved event, this part of the code checks to see if its a real IM message and not a typing event. It then separates the Instant message received the first line is loaded into a qtext variable to be used for searching for the distribution list and the rest of the message is put into a message variable which will be the message that is going to be sent to all users. Because groups (or distribution lists) in Active Directory are not usually located all in the same container or OU in Active directory this part of the script is designed to recursively search though all the OU's and the user container in Active Directory for user objects and then compares the search name with the  display name of the group. It uses functions to search through  OU's  and transverse each child OU to find all active directory groups. Once a group match is found the sendim function is used to loop through the members of the group checking to see if they have an IM address and if they do send them the message as an Instant message.

Private Sub oIMServ_OnTextReceived(ByVal pIMSession As Object, ByVal pcontact As Object, ByVal bstrMsgHeader As String, ByVal bstrMsgText As String, pfHandled As Variant)
mhead = Len(bstrMsgHeader)
slen = 1
cword = bstrMsgText
If mhead = 123 Then
    sRootDomain = "DC=AD1,DC=MAN,DC=NET,DC=AU"
    Set oRootDomain = GetObject("LDAP://" & sRootDomain)
    oRootDomain.Filter = Array("organizationalUnit")
    If InStr(slen, cword, vbCrLf) Then
        elen = InStr(slen, cword, vbCrLf)
        elen1 = elen - slen
        qtext = Mid(cword, slen, elen1)
        slen = elen + 1
        elen = Len(cword) + 1
        elen1 = elen - slen
        qmessage = Mid(cword, slen, elen1)
        df = seachou(oRootDomain, qtext, qmessage, pcontact)
        df2 = searchcont(oRootDomain, qtext, qmessage, pcontact)
    End If
End If
End Sub

Function seachou(oOusear, qtext, qmessage, pcontact)
For Each oOu In oOusear
    If oOu.Class = "group" Then
            If oOu.DisplayName = qtext Then
                dname = oOu.ADsPath
                df = SendNumber(dname, uname, qmessage, pcontact)
            End If
    
    End If
    oOu.Filter = Array("group")
        For Each ogroup In oOu
        If ogroup.Class = "group" Then
            If ogroup.DisplayName = qtext Then
                dname = ogroup.ADsPath
                df = SendNumber(dname, uname, qmessage, pcontact)
            End If
        End If
    Next
    oOu.Filter = Array("organizationalUnit")
    For Each oChild In oOu
        dd = seachou(oChild, qtext, qmessage, pcontact)
    Next
Next
End Function
Function searchcont(oScont, qtext, qmessage, pcontact)
oScont.Filter = Array("container")
For Each oContainer In oScont
    oContainer.Filter = Array("group")
            For Each ogroup In oContainer
            If ogroup.Class = "group" Then
                If ogroup.DisplayName = qtext Then
                    dname = ogroup.ADsPath
                    df = SendNumber(dname, uname, qmessage, pcontact)
                End If
            End If
        Next
Next
End Function
Function SendNumber(dname, uname, qmessage, pcontact)
   On Error Resume Next
   Set grp = GetObject(dname)
   Set memberList = grp.Members
   For Each member In memberList
        If member.msExchIMAddress <> "" Then
                    strMsgHeader = "Mime-Version: 1.0" & vbCrLf & "Content-Type: text/plain; charset=UTF-8" & vbCrLf & vbCrLf
                    msgType = IM_MSG_TYPE_NO_RESULT
                   Set oIMsession = oIMServ.CreateIMSession(member.msExchIMAddress)
                   oIMsession.SendText strMsgHeader, qmessage, msgType
         End If
  Next
  qmessage2 = "Message sent to " & grp.DisplayName & " Distribution Group"
  pcontact.SendText strMsgHeader, qmessage2, msgType
End Function

That's it once this is done you can compile the code and run it. It you want to run it on a ongoing basis you might want to look at running it as a service using srvany from the NT resource kit or just use the schedule service and run it on machine start-up

Using this Bot

To use this bot you need to send a multi-line IM message to it, to do this with the MSN messenger client you need to hit Shift-Enter instead of pressing Enter to get a carriage return in your line (pressing Enter will send the message). Below is a picture of IM DL in action

download code