locked
Auto-respond to a communicator message RRS feed

  • Question

  • Hi all, is it possible to auto-reply on IM messages with help of VBA?

    So that if someone writes me on Communicator, it automatically reply with certain pre-set message?

    Saturday, January 5, 2013 1:35 PM

All replies

  • You can do it using socket programming.

    You need to register MSWINSCK.ocx control.

    You need to do programming using the Winsock object with its events.

    I am pasting You Portion of code where one user form is client other as server.

    Client Form:

    Dim RsConnect As Recordset
    Private Sub bntConnect_Click()
        On Error GoTo t
           
            sock1.Close
            sock1.RemoteHost = strClnt1
            sock1.remoteport = txtPort
            sock1.Connect
       
       
        Exit Sub
    t:
        MsgBox "Error : " & Err.Description, vbCritical
    End Sub
    Private Sub bntSend_Click()
        On Error GoTo t
       
            sock1.SendData txtSend
            txtLog = txtLog & sUserName & ": " & txtSend & vbCrLf
            txtSend = ""
       
       
        Exit Sub
    t:
        'MsgBox "Error : " & Err.Description
        MsgBox "Error : " & tarUserNameC1 & " Not Available", vbOKOnly, "Other user Has Disconnected"
        sock1_Close
    End Sub
    Private Sub sock1_Close()
       
        sock1.Close
        txtLog = txtLog & "*** Disconnected" & vbCrLf

    End Sub
    Private Sub sock1_Connect()
       
        'txtLog = "Connected to " & sock1.RemoteHostIP & vbCrLf
         txtLog = "Connected to :" & tarUserNameC1 & vbCrLf
    End Sub
    Private Sub sock1_DataArrival(ByVal bytesTotal As Long)
      
        Dim dat As String
       
        sock1.GetData dat, vbString
        txtLog = txtLog & tarUserNameC1 & ": " & dat & vbCrLf

    End Sub
    Private Sub sock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
       
        txtLog = txtLog & "*** Error : Other user has Cencelled the Request : " & Description & vbCrLf
        sock1_Close
       
    End Sub

    Private Sub txtIP_Change()

    End Sub

    Private Sub txtSend_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
       If KeyCode = 13 Then
         If Len(txtSend.text) > 0 Then
            bntSend_Click
            KeyCode = 0
         End If
       End If
       
    End Sub
    Private Sub UserForm_Initialize()
     
       bntConnect_Click
       iClt1 = 1
    End Sub
    Private Sub UserForm_Terminate()
        CloseForm
    End Sub

     '''Now The Server UserForm

    Dim RsConnect As Recordset
    Private sTm, flgsTm As Boolean, isTm As Integer

    Private Sub bntListen_Click()
        On Error GoTo t
       
            sock1.Close
             
            sock1.LocalPort = txtPort
                                       
            sock1.Listen
       
       
        Exit Sub
    t:
        'MsgBox "Error : " & Err.Description, vbCritical
        If Err.Number = 10048 Then
           MsgBox "Busy ", vbOKOnly, "Please Exit"
        End If
       
    End Sub

    Private Sub bntExit_Click()
      End
    End Sub

    Private Sub bntSend_Click()
        On Error GoTo t
      
        sock1.SendData txtSend
        txtLog = txtLog & sUserName & ": " & txtSend & vbCrLf
        txtSend = ""
       
        flgsTm = True
        
         Exit Sub
    t:
        'MsgBox "Error : " & Err.Description
        If flgsTm = False Then
            isTm = DateDiff("s", sTm, Now())
            If isTm <= 12 Then
                If Err.Number = 40006 Then
                  MsgBox "Unable to Connect" & vbCrLf & "Please Retry", vbOKOnly, "Trying to Connect"
                  Exit Sub
                End If
            ElseIf isTm > 12 Then
                If Err.Number = 40006 Then
                  MsgBox "Please Try Later" & vbCrLf & "No Response", vbOKOnly, "Unable to Connect"
                  Exit Sub
                End If
            End If
        End If
       
        sock1_Close   'close the connection
       
    End Sub


    Private Sub sock1_Close()
     
        sock1.Close  'close connection
        txtLog = txtLog & "*** Disconnected" & vbCrLf

    End Sub

    Private Sub sock1_ConnectionRequest(ByVal requestID As Long)
       
        If sock1.State <> sckClosed Then sock1.Close
        sock1.Accept requestID
        'txtLog = "Client Connected. IP : " & sock1.RemoteHostIP & vbCrLf
         txtLog = "Client Connected. IP : " & tarUserNameS1 & vbCrLf
    End Sub
    Private Sub sock1_DataArrival(ByVal bytesTotal As Long)
       
        Dim dat As String
        sock1.GetData dat, vbString
        txtLog = txtLog & tarUserNameS1 & ": " & dat & vbCrLf

    End Sub

    Private Sub sock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
       
        txtLog = txtLog & "*** Error : " & Description & vbCrLf
        sock1_Close
       
     
    End Sub

    Private Sub txtSend_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
         If KeyCode = 13 Then
          If Len(txtSend.text) > 0 Then
            
             bntSend_Click
             KeyCode = 0
           
          End If
        End If
       
    End Sub
    Private Sub UserForm_Initialize()
       bntListen_Click
       sTm = Now
       flgsTm = False
    End Sub
    Private Sub UserForm_Terminate()
        CloseForm
    End Sub

    Private Sub CloseForm()
         
          Set RsConnect = New Recordset
          RsConnect.Open "select ToFormUsed from tblConnectRequest where FromUserName ='" & sUserName & "' and ToFormUsed ='NO'", ConSource, adOpenStatic, adLockOptimistic
          If RsConnect.RecordCount > 0 Then
             With RsConnect
                  RsConnect.Fields("ToFormUsed") = "Done-" & "UnUsed"
                RsConnect.Update
            
             End With
          End If
         
          RsConnect.Close
          Set RsConnect = Nothing
        
    End Sub

     

    Tuesday, April 16, 2013 4:00 AM