OC.SendAppMail: New user introductory email

Author: Robert Lawson
Environment: Windows Server, Access/VBA, Microsoft SQL Server
Description: This code sends a new user an introductory orientation email for both email and phone/voice mail. The wording was crafted in conjunction with User Services to serve as basis for orientation training. For MS Exchange email, this email also forces the mailbox setup (known issue/consideration). The email orientation is sent upon account/mailbox creation (this also forces the Exchange mailbox setup). The phone orientation is sent when the phone is setup (when the Active Directory phone number is synced with the Cisco Unity system, see OC.CPRebuild).
Features:
- HTML form email, designed in DreamWeaver
- Personalized with variable substitution
- bcc copy to administrator and help desk
Samples:





Code:

Public Sub SendAppMail(strID As String, strUType As String, strEmailType As String, bolOnLine As Boolean, intStatus2 As Integer)

' Sends email to users

' 11-Sept-2006  Robert Lawson Creation date

' 27-Dec-2007 Robert Lawson  Updated for ADO



' strID                Passed      OneCard ID number

' strUType             Passed      User Type from GetUtype function

' strEmailType         Passed      Type of email: "NewEmailUser", "NewPhoneUser"

' bolOnLine            Passed      TRUE=you're interactive

' intstatus2            Returned    0=OK, <>0 You're not OK

On Error GoTo ErrorBegin

Dim strName As String

strName = "SendAppMail"



Dim strNETEmail As String, strFullName As String

Dim strLDCode As String, strCampusPhone As String

Dim strFrom As String, strTo As String, strBCC As String, strSubject As String, strBody As String

Dim strFile As String, strLine As String, strExt



Const conFullName = "#FULLNAME#"

Const conPhoneNumber = "#PHONENUMBER#"

Const conLDCode = "#LDCODE#"

Const conEmail = "#EMAIL#"



Const conEmailUserAdmin = "Robert.Lawson@uni.edu"

Const conPhoneUserAdmin = "winky@uni.edu,Robert.Lawson@uni.edu,sleepy@uni.edu"

Const conOneCardAdmin = "admin@uni.edu"



intStatus2 = 0

strMessage = conNoMessage



Call LoadSysDbconn(intStatus)

If intStatus <> 0 Then

    strMessage = "Error calling LoadSysDbconn."

    Err.Raise (vbObjectError + 10), , strMessage

    GoTo ErrorBegin

End If

strTodayDate = Format(Now(), "mm/dd/yyyy")



' Valid type?

If Not (strEmailType = conEmailUser Or strEmailType = conPhoneUser) Then

    strMessage = strName & ":invalid EmailType = " & strEmailType

    intStatus2 = -10

    GoTo ErrorBegin

End If



' Get person's info

strSQL = "SELECT * FROM OneCardMaster WHERE ID = '" & strID & "'"

Debug.Print strSQL

Set objRS = CreateObject("ADODB.Recordset")

objRS.Open strSQL, conDbOneCard, adOpenDynamic, adLockReadOnly ' read access

With objRS

If (.BOF Or .EOF) Then

    strMessage = strName & ": Unable to get OneCardMaster record for ID = " & strID

    intStatus2 = -20

    GoTo ErrorBegin

Else

    strNETEmail = Nz(!NETEMail, "")

    strFullName = Trim(Nz(!NameFirst, "")) & " " & Trim(Nz(!NameLast, ""))

    strCampusPhone = Trim(Nz(!CampusPhone, ""))

End If

End With

Set objRS = Nothing



' Verify they have email address

If (Len(strNETEmail) = 0) Then

    strMessage = strName & ": No email for ID = " & strID

    intStatus2 = -30

    GoTo ErrorBegin

End If



' Get Long Distance Code ***********************

If strEmailType = conPhoneUser Then

    'strExt = Right(strCampusPhone, 4)

    'strSQL = "SELECT code FROM FACInfo WHERE description =  " & """" & strExt & """"

    'Debug.Print strSQL

    'Set rs = Db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)

    'If (rs.BOF Or rs.EOF) Then

    '    StrMessage = strName & ": Unable to get Long Distance code for ID  = " & strID

    '    intstatus2 = -1

    '    GoTo ErrorBegin

    'End If

    'strLDCode = rs!code

    'rs.Close

    strLDCode = " "

End If



' Set correct variables for email type

If strEmailType = conEmailUser Then

    strFile = "D:\Data\doc\OneCardNoticeMail.htm"

    strTo = strNETEmail

    strFrom = conOneCardAdmin

    strBCC = conEmailUserAdmin

    strSubject = "Your email information" & strFullName

ElseIf strEmailType = conPhoneUser Then

    strFile = "D:\Data\doc\OneCardNoticePhone.htm"

    strTo = strNETEmail

    strFrom = conOneCardAdmin

    strBCC = conPhoneUserAdmin

    strSubject = "Your phone information" & strFullName

End If



' Open file for email body (it must be in HTML format)

strBody = ""

Open strFile For Input As #1

Do Until EOF(1)

  Line Input #1, strLine

  strBody = strBody & strLine

Loop

Close #1

' Debug.Print strBody



' Substitute variables

If strEmailType = conEmailUser Then ' conEmail

    strBody = Replace(strBody, conFullName, strFullName)

    strBody = Replace(strBody, conEmail, strNETEmail)

ElseIf strEmailType = conPhoneUser Then

    strBody = Replace(strBody, conFullName, strFullName)

    strBody = Replace(strBody, conPhoneNumber, strCampusPhone)

    strBody = Replace(strBody, conLDCode, strLDCode)

End If



Call SendHTMLmail(strFrom, strTo, strBCC, strSubject, strBody, intStatus)

Debug.Print "intStatus = " & intStatus



' Write to trans log table

Call DoDataLog(strName, "IN", "SUB-USER", strEmailType & " email notification", "", strID, strID, bolOnLine)



ExitBegin:

    Exit Sub



ErrorBegin:

    If intStatus2 = 0 Then ' General message

        strMessage = "Error in " & strName & " " & Err.Number & " " & Err.Description & " on strID = " & Nz(strID, "")

        intStatus2 = -100 ' I'm NOT OK

    End If

    If bolOnLine Then MsgBox strMessage

    Call DoEventLog("ERR", strName, 500, strMessage, True, bolOnLine)

    GoTo ExitBegin

End Sub