Advertisement
Advertisement
| 03.14.2008 at 12:20PM PDT, ID: 23242792 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: |
Public Function Despatch(lngSession As Long) As Boolean
Dim rst As ADODB.Recordset
Dim rstA As ADODB.Recordset 'attachments
Dim strSQL As String
Dim strHTML As String
Dim strName As String
Dim cdoMsg As Object, cdoConf As Object
On Error GoTo proc_err
'get the server set up information
strSQL = "SELECT sysESMES,sysESFRM,sysETADDR,sysETUSE FROM tblSysInfo"
Set rst = New ADODB.Recordset
rst.Open strSQL, mcnn, adOpenStatic, adLockReadOnly
mstrServer = rst!sysESMES
mstrSender = Nz(rst!sysESFRM, vbNullString)
mstrET = Nz(rst!sysETADDR, vbNullString)
mblnETUSE = Nz(rst!sysETUSE, False)
rst.Close
Set rst = Nothing
'Get the HTML for the email session
strSQL = "SELECT tHTML FROM tblHTMLTS H INNER JOIN tblESession S ON H.tID=S.stID WHERE S.sID=" & lngSession
Set rst = New ADODB.Recordset
rst.Open strSQL, mcnn, adOpenStatic, adLockReadOnly
If rst.RecordCount = 0 Then
MsgBox "No source HTML found for email session.", vbExclamation, "Can't process despatch"
GoTo proc_exit_false
End If
strHTML = rst!tHTML
rst.Close
Set rst = Nothing
strSQL = "SELECT sPath FROM tblESATT WHERE sID=" & lngSession
Set rstA = New ADODB.Recordset
rstA.Open strSQL, mcnn, adOpenStatic, adLockReadOnly
'Set up the CDO configuration
Set cdoConf = CreateObject("CDO.Configuration")
With cdoConf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdo_Basic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdo_SendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mstrServer
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mstrUID
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mstrPWD
.Update
End With
'Send out the emails
mrstS.MoveFirst
Do Until mrstS.EOF
If Not mrstS!Sent Then
'Configure the recipient name
If mrstS!Casual Then
strName = mrstS!FirstName
Else
strName = mrstS!Sal & " " & mrstS!LastName
End If
Set cdoMsg = CreateObject("CDO.Message")
With cdoMsg
Set .Configuration = cdoConf
.From = mstrSender
If mblnETUSE Then
.To = mstrET
Else
.To = mrstS!Email
End If
.Subject = mstrSubject
.HTMLBody = Replace(strHTML, "{name}", strName)
If rstA.RecordCount > 0 Then
rstA.MoveFirst
Do Until rstA.EOF
.AddAttachment rstA(0)
rstA.MoveNext
Loop
End If
.Send
RaiseEvent DoneSend(mrstS.AbsolutePosition)
End With
Set cdoMsg = Nothing
mrstS!Sent = True
mrstS.Update
End If
mrstS.MoveNext
Loop
Set cdoConf = Nothing
'Update the session record to indicate that it has been sent
strSQL = "UPDATE tblESession SET sDone=True WHERE sID=" & lngSession
mcnn.Execute strSQL
proc_exit_true:
Despatch = True
proc_exit:
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
If Not rstA Is Nothing Then
rstA.Close
Set rstA = Nothing
End If
If Not cdoMsg Is Nothing Then
Set cdoMsg = Nothing
End If
If Not cdoConf Is Nothing Then
Set cdoConf = Nothing
End If
Exit Function
proc_exit_false:
Despatch = False
GoTo proc_exit
proc_err:
Select Case ErrHand()
Case ErrAbort
Resume proc_exit_false
Case ErrRetry
Resume
Case ErrIgnore
Resume Next
End Select
End Function
|