<% '******************************************************* '* ASP 101 Sample Code - http://www.asp101.com/ * '* * '* This code is made available as a service to our * '* visitors and is provided strictly for the * '* purpose of illustration. * '* * '* http://www.asp101.com/samples/license.asp * '* * '* Please direct all inquiries to webmaster@asp101.com * '******************************************************* %> <% ' 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 %>

Your message has been sent to <%= Server.HTMLEncode(strTo) %>.

A preview of your message is below:

<%= Replace(Server.HTMLEncode(strBody), vbCrLf, "
" & vbCrLf) %>

<% Else %>

There was a problem sending your message, please try again later or notify the recipient via another method.

<% 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 & "" & 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. %>
" method="post">
While You Were Out
Message For:
Taken By:
Date: Time:
Company:
Phone:
Returned Call Please Call
Will Call Again Urgent
Message:
<% 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 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 %>