<%
' If this is from a form submission then we send a message.
' O/w we simply show the form for them to fill out.
If Request.Form("action") = "send" Then
' They've already seen and filled out the form.
' Start the message sending process...
Dim strTo ' Who the message is for
Dim strTakenBy ' Who answered the phone
Dim strCaller ' Who was calling
Dim strSubject ' Out email subject line
Dim strBody ' Our email message body
Dim bMsgSent ' Boolean indication success or failure
' Get the users involed
strTo = Request.Form("to")
strTakenBy = Request.Form("takenby")
strCaller = Request.Form("caller")
' Build our subject line
strSubject = "Phone Msg: " & strCaller
' Build our message body
strBody = ""
strBody = strBody & "You got a phone call." & vbCrLf & vbCrLf
strBody = strBody & " From: " & Request.Form("mrs") & " " & strCaller & vbCrLf
strBody = strBody & " Of: " & Request.Form("company") & vbCrLf
strBody = strBody & " On: " & Request.Form("date") & vbCrLf
strBody = strBody & " At: " & Request.Form("time") & vbCrLf
strBody = strBody & "Phone: " & Request.Form("phone") & vbCrLf
strBody = strBody & "Notes: " & Request.Form("notes") & vbCrLf
strBody = strBody & vbCrLf & "Message:" & vbCrLf
strBody = strBody & Request.Form("message") & vbCrLf
' Send the message and store status sent back
bMsgSent = SendEmail(strTakenBy, strTo, strSubject, strBody)
' Display either success or failure message
If bMsgSent Then
%>
<p>
<b>Your message has been sent to <%= Server.HTMLEncode(strTo) %>.</b>
</p>
<p>
A preview of your message is below:
</p>
<p>
<%= Replace(Server.HTMLEncode(strBody), vbCrLf, "<br />" & vbCrLf) %>
</p>
<%
Else
%>
<p>
There was a problem sending your message, please try
again later or notify the recipient via another method.
</p>
<%
End If
Else
' This means we're displaying the form so here goes...
' To make this interesting I'm getting a list of employees
' from a DB or text file so you don't have to keep typing
' the names into the form fields.
' The recordset is for the employee list. I then build a
' set of options for use with any select box and store it
' in the string variable for multiple uses. The last var
' is just a temp building area.
Dim rstEmployeeList
Dim strEmpOptions
Dim strTemp
' Expected format for our recordset is: first, last, email
' Both the DB and Text File routines work and are listed
' below. I was just going to do a text file, but I figured
' people would immediately want to hook this up to their
' employee DB so I added that capability as well.
' Modifying the DB function to work with your DB should
' be pretty straight forward.
'
' Make sure only one of the lines below is un-commented
' or you'll be doing twice the work you need to!
Set rstEmployeeList = GetCompanyListFromFile(Server.MapPath("phonemsg.txt"))
'Set rstEmployeeList = GetCompanyListFromDB
' Start with first employee
rstEmployeeList.MoveFirst
' Loop through the RS and build the option string.
Do While Not rstEmployeeList.EOF
strTemp = rstEmployeeList.Fields("first").Value & " " _
& rstEmployeeList.Fields("last").Value & " " _
& "<" & rstEmployeeList.Fields("email").Value & ">"
strEmpOptions = strEmpOptions & "<option value=""" & strTemp & """>" _
& strTemp & "</option>" & vbCrLf
rstEmployeeList.MoveNext
Loop
' Close and dispose of our RS
rstEmployeeList.Close
Set rstEmployeeList = Nothing
' Now we just build our form.
' The message for section was originally built from the same
' string as shown in the commented out section, but so you can
' play with it on our site, I thought I should open it up to
' let you enter any address.
%>
<form action="<%= Request.ServerVariables("URL") %>" method="post">
<input type="hidden" name="action" value="send" />
<table border="0" cellspacing="0" cellpadding="0"><tr><td>
<table border="0" cellspacing="2" cellpadding="2">
<tr>
<td colspan="4" align="center">
<font size="+2"><b>While You Were Out</b></font>
</td>
</tr>
<tr>
<td align="right">Message For:</td>
<td colspan="3">
<input type="text" name="to" value="Enter Email" size="30" />
<!--
<select name="to" />
<%= strEmpOptions %>
</select>
-->
</td>
</tr>
<tr>
<td align="right">Taken By:</td>
<td colspan="3">
<select name="takenby" />
<%= strEmpOptions %>
</select>
</td>
</tr>
<tr>
<td align="right">Date:</td>
<td><input type="text" name="date" value="<%= Date() %>" size="10" /></td>
<td align="right">Time:</td>
<td><input type="text" name="time" value="<%= Time() %>" size="10" /></td>
</td>
</tr>
<tr>
<td align="right">
<select name="mrs">
<option>Mr.</option>
<option>Mrs.</option>
<option>Ms.</option>
</select>
</td>
<td colspan="3"><input type="text" name="caller" size="30" /></td>
</tr>
<tr>
<td align="right">Company:</td>
<td colspan="3"><input type="text" name="company" size="30" /></td>
</tr>
<tr>
<td align="right">Phone:</td>
<td colspan="3"><input type="text" name="phone" size="30" /></td>
</tr>
<tr>
<td>
</td>
<td colspan="3">
<table border="0" cellspacing="1" cellpadding="0">
<tr>
<td><input type="checkbox" name="notes" value="Returned Call" />Returned Call</input></td>
<td><input type="checkbox" name="notes" value="Please Call" />Please Call</input></td>
</tr>
<tr>
<td><input type="checkbox" name="notes" value="Will Call Again" />Will Call Again</input></td>
<td><input type="checkbox" name="notes" value="Urgent" />Urgent</input></td>
</tr>
</table>
</td>
</tr>
</table>
<table border="0" cellspacing="2" cellpadding="2">
<tr>
<td colspan="4">
Message:<br />
<textarea name="message" cols="40" rows="10" wrap="virtual"></textarea>
</td>
</tr>
<tr>
<td colspan="4" align="right">
<input type="submit" value="Send Message" />
</td>
</tr>
</table>
</td></tr></table>
</form>
<%
End If
' Reads the employee list in from a file and
' returns a recordset containing the data.
Function GetCompanyListFromFile(strFileFullPath)
Const ForReading = 1
Const adVarChar = 200
Const FieldDelimiter = "|"
' This won't work:
'Const RecordDelimiter = vbCrLf
' So...
Dim RecordDelimiter
RecordDelimiter = vbCrLf
' Anyone know if this can be implemented as a Const?
' If so I'd love to see it... mailto:john@asp101.com
Dim objFSO, objFile
Dim strFile
Dim arrCompanyList
Dim rstTemp
Dim arrTemp
Dim I
' Read in the entire file
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFileFullPath, ForReading, False)
strFile = objFile.ReadAll
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
' Deal with trailing delimiters
Do While Right(strFile, Len(RecordDelimiter)) = RecordDelimiter
strFile = Left(strFile, Len(strFile) - Len(RecordDelimiter))
Loop
' Split each line into an array
arrCompanyList = Split(strFile, RecordDelimiter)
' Set up our new RS
Set rstTemp = Server.CreateObject("ADODB.Recordset")
rstTemp.Fields.Append "first", adVarChar, 255
rstTemp.Fields.Append "last", adVarChar, 255
rstTemp.Fields.Append "email", adVarChar, 255
' Open it up
rstTemp.Open
' Loop through the array adding entries to the RS
For I = LBound(arrCompanyList) To UBound(arrCompanyList)
arrTemp = Split(arrCompanyList(I), FieldDelimiter)
rstTemp.AddNew
rstTemp.Fields("first").Value = arrTemp(0)
rstTemp.Fields("last").Value = arrTemp(1)
rstTemp.Fields("email").Value = arrTemp(2)
rstTemp.Update
Next
' Set the RS as the functions return value
Set GetCompanyListFromFile = rstTemp
End Function
' This is simply a skeleton for you to use since I knew
' I'd get questions about it if I didn't provide one.
Function GetCompanyListFromDB()
Const adUseClient = 3
Const adOpenStatic = 3
Const adLockReadOnly = 1
Const adCmdText = &H0001
Dim cnnTemp, rstTemp
' Connect to our DB
Set cnnTemp = Server.CreateObject("ADODB.Connection")
cnnTemp.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" _
& Server.MapPath("phonemsg.mdb") & "; User Id=admin; " _
& "Password=;"
' Create a RS that we can disconnect
Set rstTemp = Server.CreateObject("ADODB.Recordset")
rstTemp.CursorLocation = adUseClient
Set rstTemp.ActiveConnection = cnnTemp
' Get the data... this is where you could change the
' sort order if you wanted to.
rstTemp.Open "SELECT first, last, email " _
& "FROM tblPhoneList ORDER BY last;" _
, , adOpenStatic, adLockReadOnly, adCmdText
' Diconnect
Set rstTemp.ActiveConnection = Nothing
' Close and dispose of our connection
cnnTemp.Close
Set cnnTemp = Nothing
' Set the RS as the functions return value
Set GetCompanyListFromDB = rstTemp
End Function
' Simply sends a basic email message
Function SendEmail(strFrom, strTo, strSubject, strBody)
On Error Resume Next
Dim objMessage
Dim bSuccess
' Set default to success
bSuccess = True
' Quick check for valid email addr
If IsValidEmail(strTo) Then
' Note that I'm using the Win2000 CDO and not CDONTS!
' Could be either, but I figured I'd let you guys
' see the new syntax since I rarely use it.
Set objMessage = Server.CreateObject("CDO.Message")
objMessage.To = strTo
objMessage.From = strFrom
objMessage.Subject = strSubject
objMessage.TextBody = strBody
objMessage.Send
Set objMessage = Nothing
Else
' If email is invalid abort w/ a failure code.
bSuccess = False
End If
' Check for errors
If Err.number <> 0 Then
bSuccess = False
End If
' Set return status
SendEmail = bSuccess
End Function
' A quick email syntax checker. It's pretty lame
' but it's quick and easy and will catch people
' who enter nothing. Note it's pretty darn lax
' because I allow this format:
' User Name <username@domain.com>
Function IsValidEmail(strEmail)
Dim bIsValid
bIsValid = True
If Len(strEmail) < 5 Then
bIsValid = False
Else
If InStr(1, strEmail, "@", 1) < 2 Then
bIsValid = False
Else
If InStrRev(strEmail, ".") < InStr(1, strEmail, "@", 1) + 2 Then
bIsValid = False
End If
End If
End If
IsValidEmail = bIsValid
End Function
%>