Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations dencom on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Remote Call Forward via text message 1

Status
Not open for further replies.

30n30w

IS-IT--Management
Feb 3, 2013
261
US
I’m opening this new thread because a couple of folks were intrigued by a system I developed for my own use, but have now rolled it out to some staff members. I started to hijack another thread with this conversation, so I’m starting a new thread so it can stand on it’s own.
I’m fairly old school here, still running Motorola processors on Release 4.5 (highest release possible on the old processors) 61c, Callpilot 201i/5.0. I never allowed remote call forward because it’s troublesome for users to remember how, and I refuse to allow DISA for abuse and maintenance reasons. But I still wanted a way to forward my desk phone to my cell or directly to voicemail when I was out of the office.
With some creative thinking and a little Outlook VBA programming, you can setup a windows box running outlook to monitor incoming email (text messages ) and when it sees one from a list of authorized cell phone numbers, it can do the remote call forward of a specific DN via an old 9600 baud modem's DTMF codes. The sheer beauty of this system is that DISA isn't needed, because it's all internal (very secure) - and via outlook programming you can restrict what forwarding can be done (very very secure) Also - my users have no idea what the 7 digit SCPW is, so no one can do this by themselves; although I have to use the same SCPW for all DN's so the program can send the same one each time.

For example: I text the words "To Me" from my cell to the windows box email address ("cfwd@domain.com"), and the system receives this, triggers a script which operates a modem to dial the correct FFC’s,SCPW, and numbers needed to RCFW my extension (matched to my cell number via ‘Contacts’ in outlook) to my cell phone. If I text "To VM", it will forward my extension to voicemail . If I text "To Desk" it cancels RCFW. And outlook is programmed to confirm each change via a reply text message .

I didn't bother with error checking to confirm each step, because when the modem is dialing DTMF, it generally doesn't make mistakes so once it works, it should work every time, for everyone who is setup for it.

With a little more programming, you could set it up to do just about anything; it's all based on how the outlook programming deciphers the text message. I have another script setup so when it sees a DN instead of Alpha Char (ie "5273”) it will RCFW that DN to the texting cell phone number, assuming it’s authorized in “contacts” - this is a little trickier, but doable.
I COULD enable users to forward to any number, simply by programming it to look for a text message that would say something like: “1234;9195551212” which theoretically would offsite call forward Dn 1234 to 919-555-1212. When you delve in to these fancier capabilities, beware of the user's unlimited capacity for stupidity. You will need to write all sorts of error checking to keep your scripts from hanging due to a typo, bad number, wrong length, etc… You would also have to trust your users to not forward to drug lords in third world counties. It could be abused, but only if you allow it to be; keeping it simple works for me.

I’ll include my code for outlook VBA in the next post. (don’t laugh at my awkward code – I never claimed to be a programmer; I’m sure someone else could do the same tasks with cleaner, more elegant code; I just hope they remember where the idea came from! I had to learn some VBA to accomplish what I wanted to do.)

30n30w
 
I'm running Outlook 2010 on a Windows Server 2003 (this could be any machine, I'm just using a server because I have one running CPMGR and CP Reporter and it's the network backup machine for callpilot, so it's in the server farm, available 24x7 and not busy much. You could do this on a virtual machine, but setting up a physical modem on a VM is much trickier)
We use Exchange, but again none of this is critical to making this work - I think any email program could ultimately by used, as long as you can program/script it.


********************************************
In the Outlook contact list, I use the fields Full Name, Job Title, and Company (because they are there, and easy to display when I was troubleshooting)

Full Name: Joe Schmo
Job Title: 1234;5273 (user's DN is 1234 but they can also fwd dept DN of 5273 to their phone)
Company: 3334445555@mms.att.net (users cell phone text message address)


So this person can fwd their own DN (1234) to their cell phone or vm or cancel
This person can also cause the department DN of 5273 to forward to their cell phone, which would be overridden by the next department person doing the same.
If the person doesn't need the department DN functionality, I only put their DN in the Job Title Field ie 1234
Obviously, if it's not in the contact list, the system doesn't do anything but spit an error.

**********************************************


VBA CODE:

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub textdropper(MyMail As MailItem)
Dim StrID As String
Dim objNS As Outlook.NameSpace
Dim objMail As Outlook.MailItem
Dim vcell As String
Dim vext As String
Dim vname As String
Dim vbilling As String
Dim vvirtual As String
Dim strout As String
Dim textmess As String

StrID = MyMail.EntryID
Set objNS = Application.GetNamespace("MAPI")
Set objMail = objNS.GetItemFromID(StrID)

email_addy = objMail.SenderEmailAddress
textmess = LCase(Trim(objMail.Body))


If FindAddy(objMail.SenderEmailAddress, vext, vname, vvirtual) <> "NOTFOUND" Then

vcell = Left(email_addy, 10)
Dim myReply As Outlook.MailItem
Set myReply = objMail.Reply
Dim com_port As Object
If LCase(Trim(textmess)) = "help" Then [highlight #FCE94F]'Send user some help info[/highlight]
With myReply
.Subject = ""
.Body = "Help Info for directing your Extension to your cell phone, Don't include the braces [ ]." & vbNewLine & "Text the following: " & vbNewLine & vbNewLine & "[To cell] forward to cell." & vbNewLine & "[To vm] to voicemail. " & vbNewLine & "[To desk] cancel forward."
.Send
End With

ElseIf LCase(Trim(textmess)) = "5273" Then [highlight #FCE94F]' these are "special" cases for forwarding a specific DN - the users texts the DN to the system and it forwards that DN to them.[/highlight]

If LCase(Trim(textmess)) = vvirtual Then

Set com_port = CreateObject("NETCommOCX.NETComm")[highlight #FCE94F]'your modem settings may vary[/highlight]
com_port.commport = 3
com_port.settings = "57600,N,8,1"
com_port.InputLen = 1024
com_port.RThreshold = 0
com_port.RThreshold = 0
com_port.PortOpen = True
Sleep (3000)

strout = "ATDT*722123456752739" & vcell & "#" [highlight #FCE94F]'these strings contains universal SCPW 1234567[/highlight]
com_port.Output = strout & vbCrLf
Sleep (8000)
com_port.Output = "ATH0"
Sleep (2000)
com_port.PortOpen = False
Set com_port = Nothing
With myReply
.Subject = ""
.Body = vname & "," & vbNewLine & "888.555.5273 has been forwarded to cellular number: " & vbNewLine & vcell
'.BCC = "email@domain.com"
.BCC = "emails@domain.com"
.Send
End With
Else
With myReply
.Subject = ""
.Body = "An ERROR has occurred - Please Contact Joe Schmo @ 212.555.1212."
.BCC = "phonenumber@txt.att.net"
.Send
End With
End If

ElseIf LCase(Trim(textmess)) = "5433" Then [highlight #FCE94F]' these are "special" cases for forwarding a specific DN[/highlight]

If LCase(Trim(textmess)) = vvirtual Then

Set com_port = CreateObject("NETCommOCX.NETComm")
com_port.commport = 3
com_port.settings = "57600,N,8,1"
com_port.InputLen = 1024
com_port.RThreshold = 0
com_port.RThreshold = 0
com_port.PortOpen = True
Sleep (3000)

strout = "ATDT*722123456754339" & vcell & "#"
com_port.Output = strout & vbCrLf
Sleep (8000)
com_port.Output = "ATH0"
Sleep (2000)
com_port.PortOpen = False
Set com_port = Nothing
With myReply
.Subject = ""
.Body = vname & "," & vbNewLine & "909.313.LIFE(5433) has been forwarded to cellular number: " & vbNewLine & vcell
.BCC = "email@domain.com"
'.BCC = "emails@domain.com"
'
.Send
End With
Else
With myReply
.Subject = ""
.Body = "An ERROR has occurred - Please Contact Joe Schmo @ 212.555.1212."
.BCC = "phonenumber@txt.att.net"
.Send
End With
End If

ElseIf LCase(Trim(textmess)) = "to cell" Then
Set com_port = CreateObject("NETCommOCX.NETComm")
com_port.commport = 3
com_port.settings = "57600,N,8,1"
com_port.InputLen = 1024
com_port.RThreshold = 0
com_port.RThreshold = 0
com_port.PortOpen = True
Sleep (1000)
com_port.Output = "ATDT*7221234567" & vext & "87" & vext & "#" & vbCrLf [highlight #FCE94F]'forward to cell phone[/highlight]
Sleep (7000)
com_port.Output = "ATH0"
Sleep (2000)
com_port.PortOpen = False
Set com_port = Nothing
With myReply
.Subject = ""
.Body = vname & "," & vbNewLine & "your ext " & vext & ", has been forwarded to your cell. " & vbNewLine & vbNewLine & "To Change:" & vbNewLine & "[To vm] to voicemail. " & vbNewLine & "[To desk] cancel forward."
.Send
End With


ElseIf LCase(Trim(textmess)) = "to desk" Then
Set com_port = CreateObject("NETCommOCX.NETComm")
com_port.commport = 3
com_port.settings = "57600,N,8,1"
com_port.InputLen = 1024
com_port.RThreshold = 0
com_port.RThreshold = 0
com_port.PortOpen = True
Sleep (1000)
com_port.Output = "ATDT*7221234567" & vext & "2422#" & vbCrLf [highlight #FCE94F]' send it to somewhere temp (callpilot CDN) before cancelling it completely. This keeps it from causing reorder/error tone on the modem if RCFW isn't active currently.[/highlight]
Sleep (7000)
com_port.Output = "ATH0"
Sleep (2000)
com_port.PortOpen = False
Sleep (1000)
com_port.PortOpen = True
Sleep (2000)
com_port.Output = "ATDT*7231234567" & vext & vbCrLf
Sleep (6000)

com_port.PortOpen = False
Set com_port = Nothing
With myReply
.Subject = ""
.Body = vname & "," & vbNewLine & "your ext " & vext & " now rings at your desk. Fowarding has been cancelled." & vbNewLine & vbNewLine & "To Change:" & vbNewLine & "[To cell] forward to cell." & vbNewLine & "[To vm] to voicemail. "
.Send
End With
ElseIf LCase(Trim(textmess)) = "to vm" Then
Set com_port = CreateObject("NETCommOCX.NETComm")
com_port.commport = 3
com_port.settings = "57600,N,8,1"
com_port.InputLen = 1024
com_port.RThreshold = 0
com_port.RThreshold = 0
com_port.PortOpen = True
Sleep (1000)
com_port.Output = "ATDT*7221234567" & vext & "2422#" & vbCrLf [highlight #FCE94F]' this sends it to the callpilot CDN 2422[/highlight]
Sleep (7000)
com_port.Output = "ATH0"
Sleep (1000)
com_port.PortOpen = False
Set com_port = Nothing
With myReply
.Subject = ""
.Body = vname & "," & vbNewLine & "your ext " & vext & " is now forwarded directly to voicemail." & vbNewLine & vbNewLine & "To Change:" & vbNewLine & "[To cell] forward to cell." & vbNewLine & "[To desk] cancel forward. "
.Send
End With
Else
With myReply
.Subject = ""
.Body = "An ERROR has occurred - Please Contact the Support Desk."
.Send
End With

End If
objMail.UnRead = False
objMail.BillingInformation = vname
objMail.Save
Else
objMail.UnRead = True
objMail.Save
End If



End Sub






Function FindAddy(email_addy As String, vext As String, vname As String, vvirtual As String)
'Dim objApp As Application
'Dim objNS As NameSpace
Dim objContacts As MAPIFolder
Dim colItems As Items
Dim objItem As Object
Dim strAddress As String
Dim strWhere As String
Dim blnFound As Boolean
Dim stradd As String

' get folder to search
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objContacts = objNS.GetDefaultFolder(olFolderContacts)
strWhere = "[Email1Address] <> vbNullString " & _
"Or [Email2Address] <> vbNullString " & _
"Or [CompanyName] <> vbNullString "
Set colItems = objContacts.Items.Restrict(strWhere)

' get address to search for
strAddress = email_addy
If strAddress <> "" Then
colItems.SetColumns ("CompanyName, JobTitle,FullName")
For Each objItem In colItems
' must test for item type to avoid distribution lists
If TypeName(objItem) = "ContactItem" Then
If InStr(objItem.CompanyName, strAddress) > 0 Then

'MsgBox objItem.CompanyName
email_addy = objItem.CompanyName
If Len(Trim(objItem.JobTitle)) = 4 Then
vext = objItem.JobTitle
vvirtual = ""
Else
vext = Left(Trim(objItem.JobTitle), 4)
vvirtual = Right(Trim(objItem.JobTitle), 4)
End If

vname = objItem.FullName
blnFound = True
Exit For
End If
End If
Next
End If

If Not blnFound Then
' MsgBox "Not Found"
addy_found = False
FindAddy = "NOTFOUND"
Else
addy_found = True
FindAddy = True

End If

Set objItem = Nothing
Set colItems = Nothing
Set objContacts = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function



Function Quote(data_in) As String
Quote = Chr(34) & CStr(data_in) & Chr(34)
End Function




Function IsInContacts(VvCpSmtp As String) [highlight #FCE94F]' This function probably isn't needed for this - it's probably a carryover from other code[/highlight]
'Dim objApp As Application
'Dim objNS As NameSpace
Dim objFolder As Outlook.Folder
Dim objTable As Outlook.Table
Dim objRow As Outlook.Row
Dim objItems As Outlook.Items
Dim objContact As Outlook.ContactItem


Dim StrFind As String
Dim blnIsInContacts As Boolean
blnIsInContacts = False

Set objNS = Application.Session
Set objFolder = objNS.GetDefaultFolder(olFolderContacts)
Set objTable = objFolder.GetTable
StrFind = "[Email1Address] = " & Quote(VvCpSmtp)
Set objRow = objTable.FindRow(StrFind)


If Not objRow Is Nothing Then
blnIsInContacts = True
' email_addy = objContact.EntryID
End If

IsInContacts = blnIsInContacts

Set objRow = Nothing
Set objTable = Nothing
Set objFolder = Nothing
' Set ObjNS = Nothing
'Set objApp = Nothing
End Function






 
I guess that I should point out the fact that my FFC codes (*722 *723 etc) and SCPW string may be different than what is set on other systems. Consequently, the ATDT dialing strings would need to be changed to match the system being used.

30n30w
 
Thanks 30n30w! I will definitely be giving this a try (when I have some spare time).
 
A quick note for those that might be attempting to try this:

Outlook VBA has some reference libraries active; I can’t swear that they are all required however if the code doesn’t execute properly….you might be missing a library reference - These are currently loaded within the VBA references list:
Visual Basic for Applications
Microsoft Outlook 14.0 Object Library
OLE automation
Microsoft Office 14.0 Object Library
MSComm32.ocx replacement
MSTIME

I’m not sure if the MSTIME is required, or it was something else I was playing with at another time. The MSComm32.ocx replacement library I obtained off the internet from a VBA programming forum link; it should still be available out there. The rest should be included with office/outlook…Good Luck!

30n30w
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top