Multi-Part email from DTS - SQL Server Forums

Please start any new threads on our new site at https://forums.sqlteam.com. We've got lots of great SQL Server experts to answer whatever question you can come up with.

All Forums

SQL Server 2000 Forums

Import/Export (DTS) and Replication (2000)

Multi-Part email from DTS

Author

Topic

Stevan2020
Starting Member

25 Posts

Posted - 2005-01-10 : 12:56:42

I am sending scheduled email from an ActiveX script within a DTS package. The email message is sent correctly. I cannot use SQl Mail, as this is turned off.

The problem is that a plain text version of the email needs to be sent to PDA type devices (Blackberry). i am attempting to use the coding for Multi-Part Messages, but I have not been able to figure out exactly how to format the message.

The HTML version can be sent correctly, but part the coding for Multi-Part messages appears as plain text.

-- Steve

Here is the current code............

'*******************************************************************
' Visual Basic ActiveX Script
'********************************************************************

' CdoProtocolsAuthentication Enum
const cdoAnonymous = 0
const cdoBasic = 1
const cdoNTLM = 2

' CdoSendUsing Enum
const cdoSendUsingPickup = 1
const cdoSendUsingPort = 2
const cdoSendUsingExchange = 3

Function Main()

' Define Global Vars
Dim sServerName
Dim sDatabaseName
Dim sUserID
Dim sUserPwd
Dim sDebug
Dim sqlUpdate

' Get global variables
sServerName = DTSGlobalVariables("ServerName").Value
sDatabaseName = DTSGlobalVariables("DatabaseName").Value
sUserID = DTSGlobalVariables("UserID").Value
sUserPwd = DTSGlobalVariables("UserPwd").Value
sDebug = DTSGlobalVariables("Debug").Value

' Check Global Variables

if sDebug = "1" then
MsgBox(" Running in Debug mode")
end if

if IsNull(sServerName) or IsEmpty(sServerName) then
Main = DTSTaskExecResult_Failure
end if

if IsNull(sDatabaseName) or IsEmpty(sDatabaseName) then
Main = DTSTaskExecResult_Failure
end if

if IsNull(sUserID) or IsEmpty(sUserID) then
Main = DTSTaskExecResult_Failure
end if

if IsNull(sUserPwd) or IsEmpty(sUserPwd) then
Main = DTSTaskExecResult_Failure
end if

' Create Objects

SET oConn = CreateObject("ADODB.Connection")
SET rsNonDel= CreateObject("ADODB.Recordset")
SET rsTO = CreateObject("ADODB.Recordset")

' "Data Source=" & sServerName &";" & _
sSQLConnString = "Provider=sqloledb;" & _
"Data Source=eagnmnsx840;" & _
"Initial Catalog=" & sDatabaseName &";" & _
"User Id=" & sUserID &";" & _
"Password=" & sUserPwd

oConn.open( sSQLConnString)

rsNonDel.ActiveConnection = oConn
rsNonDel.Source = "SELECT N.OfficeID, O.MgrCode, N.ReportDate, " & _
" O.PostOffice + CASE WHEN O.OfficeName like 'MAIN%' THEN ' ' WHEN O.OfficeName like 'MOD%' THEN ' ' WHEN O.OfficeName like 'DETACH%' THEN ',' + ' ' + 'DCU' WHEN O.OfficeName like 'TEMP%' THEN ',' + ' ' + 'DCU' WHEN O.OfficeName not like 'MAIN%' or O.OfficeName not like 'MOD%' or O.OfficeName not like 'TEMP%' or O.OfficeName not like 'DETACH' THEN ',' + ' ' + O.OfficeName END as Office," & _
" N.Routes, N.MissedDels, N.Letters, N.Flats,N.Parcels, N.Comment " & _
" FROM dbo.tbl_NonDelivery N " & _
" JOIN Portland_ClusterDB.dbo.tbl_Offices O on n.OfficeId = O.OfficeID " & _
" WHERE (Convert(varchar(11), ReportDate) = Convert(varchar(11), GETDATE())) and emailSent = 0 " & _
" ORDER BY MgrCode, Office "
rsNonDel.CursorLocation = 3
rsNonDel.CursorType = 2
rsNonDel.LockType = 3
rsNonDel.Open

If rsNonDel.RecordCount > 0 Then '' ****** A records exists, send message

Dim dtDate
dtDate = (rsNonDel.Fields.Item("ReportDate").Value)

rsTO.ActiveConnection = oConn
rsTO.Source = " SELECT eMailAddress FROM Portland_SpecialDB.dbo.tbl_Disp_Email WHERE NonDeliveryEmail = 1"
rsTO.CursorLocation = 3
rsTO.CursorType = 2
rsTO.LockType = 3
rsTO.Open

Dim eMailTO
eMailTO = ""
Dim i
i = 0

rsTO.MoveFirst
While NOT rsTO.EOF
i = i + 1
eMailTO = eMailTO & (rsTO.Fields.Item("eMailAddress").Value) &"@email.usps.gov, "
rsTO.MoveNext
WEND

eMailTO = Left(Trim(eMailTO), (Len(Trim(eMailTO)) - 1) )

Dim iMsg
Dim iConf
Dim Flds
Dim strSubject
Dim strMsgBody
' Dim strContentType

' ***** This is a Mult-ipart MIME Message
' strContentType = " Content-Type: multipart/related; " & vbcrlf
' strContentType = strContentType & " boundary=""----=_NextPart_32252.1057009685.31.001""; " & vbcrlf
' strContentType = strContentType & " type=""multipart/alternative"" " & vbcrlf & vbcrlf

strSubject = "Non-Delivery Daily Report for " & dtDate

strMsgBody = ""

' ***** This is a Mult-ipart MIME Message
strMsgBody = " Content-Type: multipart/related; " & vbcrlf
strMsgBody = strMsgBody & " boundary=""----=_NextPart_32252.1057009685.31.001""; " & vbcrlf
strMsgBody = strMsgBody & " type=""multipart/alternative"" " & vbcrlf & vbcrlf

' ***** Marker for PLAIN TEXT part message in mime format
strMsgBody = strMsgBody & " ------=_NextPart_32252.1057009685.31.001 " & vbcrlf
strMsgBody = strMsgBody & " Content-Type: multipart/alternative; " & vbcrlf
strMsgBody = strMsgBody & " boundary=""----=_NextPart_32252.1057009685.31.002"" " & vbcrlf
strMsgBody = strMsgBody & " Content-Description: Message in alternative text and HTML forms " & vbcrlf & vbcrlf

strMsgBody = strMsgBody & "------=_NextPart_32252.1057009685.31.002 " & vbcrlf
strMsgBody = strMsgBody & " Content-Type: text/plain; " & vbcrlf
strMsgBody = strMsgBody & " charset=""iso-8859-1"" " & vbcrlf
strMsgBody = strMsgBody & " Content-Transfer-Encoding: quoted-printable " & vbcrlf
strMsgBody = strMsgBody & " Content-Description: Message in plain-text form " & vbcrlf & vbcrlf

'' ***** PlainText message

strMsgBody = strMsgBody &"Hello Joe, This is a BLACKBERRY message" & vbcrlf

' ***** Marker for HTML part message in mime format
strMsgBody = strMsgBody &" ------=_NextPart_32252.1057009685.31.002 " & vbcrlf
strMsgBody = strMsgBody & " Content-Type: text/html; " & vbcrlf
strMsgBody = strMsgBody & " charset=""iso-8859-1"" " & vbcrlf
strMsgBody = strMsgBody & " Content-Transfer-Encoding: quoted-printable " & vbcrlf
strMsgBody = strMsgBody & " Content-Description: Message in HTML form " & vbcrlf

'' ***** The HTML message
strMsgBody = strMsgBody & "<html>"
strMsgBody = strMsgBody & "<body>"
strMsgBody = strMsgBody & "<h3><font face='Arial, Helvetica, sans-serif' size='2' color='#0000FF'> "
strMsgBody = strMsgBody & " Non-Delivery Report for " & dtDate
strMsgBody = strMsgBody & "</font></h3>"

strMsgBody = strMsgBody & "<table border='1' bordercolorlight='#7DADD0' bordercolordark='#588DC9' bgColor='#FFFFFF' cellspacing='0' cellpadding='3 style='font: Arial; size:2''>"
strMsgBody = strMsgBody & "<tr bgcolor='#DDEBF7' align='center'>"
strMsgBody = strMsgBody & "<td align='left'>Office </td>"
strMsgBody = strMsgBody & "<td>Area</td>"
strMsgBody = strMsgBody & "<td>Routes</td>"
strMsgBody = strMsgBody & "<td>Missed Dels</td>"
strMsgBody = strMsgBody & "<td>Letters</td>"
strMsgBody = strMsgBody & "<td>Flats</td>"
strMsgBody = strMsgBody & "<td>Parcels</td>"
strMsgBody = strMsgBody & "<td>Comment</td></tr>"

' rsNonDel.MoveFirst
While NOT rsNonDel.eof

strMsgBody = strMsgBody & "<tr bgcolor='#DDEBF7'>"
strMsgBody = strMsgBody & "<th align='left'>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("Office").Value)
strMsgBody = strMsgBody & "</th><th>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("MgrCode").Value)
strMsgBody = strMsgBody & "</th><th>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("Routes").Value)
strMsgBody = strMsgBody & "</th><th>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("MissedDels").Value)
strMsgBody = strMsgBody & "</th><th>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("Letters").Value)
strMsgBody = strMsgBody & "</th><th>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("Flats").Value)
strMsgBody = strMsgBody & "</th><th>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("Parcels").Value)
strMsgBody = strMsgBody & "</th><th align='left'>"
strMsgBody = strMsgBody & (rsNonDel.Fields.Item("Comment").Value)
strMsgBody = strMsgBody & "</th></tr>"

rsNonDel.MoveNext
WEND

strMsgBody = strMsgBody & "<tr>"
strMsgBody = strMsgBody & "<td style='border:none' colspan='3'>"
strMsgBody = strMsgBody & "</td>"
strMsgBody = strMsgBody & "</tr>"
strMsgBody = strMsgBody & "</table>"
strMsgBody = strMsgBody & "</body></html>"

'' ***** End Boundary marker
strMsgBody = strMsgBody & "------=_NextPart_32252.1057009685.31.002-- " & vbcrlf
strMsgBody = strMsgBody & " ------=_NextPart_32252.1057009685.31.001 " & vbcrlf
' strMsgBody = strMsgBody & " Content-Transfer-Encoding: base64 " & vbcrlf
strMsgBody = strMsgBody & " Content-ID: <1.31.32252.1057009685@pdx.usps.gov> " & vbcrlf & vbcrlf

'' ***** END signal: top-level boundary marker, two dashes, and then -- End -- on a line by itself:
strMsgBody = strMsgBody & "------=_NextPart_32252.1057009685.31.001-- " & vbcrlf
strMsgBody = strMsgBody & " -- End -- "

set iMsg = CreateObject("CDO.Message")
set iConf = CreateObject("CDO.Configuration")

set Flds = iConf.Fields

With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="email.usps.gov"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10

.Update
End With

if sDebug = "1" then
MsgBox("Text Part")
MsgBox( strSubject)
end if

' iConf("Content-Type") = strContentType

With iMsg
Set .Configuration = iConf

.To = eMailTO ' "stevan.s.cohen@usps.gov" 'Your comma separated list of recipients.
.From ="""pdx-poc""<kp7wp0@usps.gov>" ' Server where message might originate.
.Subject = strSubject
.HTMLBody = strMsgBody

.Send

if sDebug = "1" then
MsgBox("HTML Part")
MsgBox( iMsg.HTMLBody)
end if

End With

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing

rsNonDel.Close()
Set rsNonDel = Nothing

rsTO.Close()
Set rsTO = Nothing

sqlUpdate = " UPDATE tbl_NonDelivery " &_
" SET emailSent = 1, emailDate = DateAdd(hh, -2, GETDATE() ) " &_
" WHERE (CONVERT(varchar(11), ReportDate) = CONVERT(varchar(11), GETDATE())) " &_
" AND (emailSent = 0) "

' oConn.Execute( sqlUpdate)

ELSE '' ***** No records

End If

Main = DTSTaskExecResult_Success

End Function

Subscribe to SQLTeam.com

SQLTeam.com Articles via RSS

SQLTeam.com Weblog via RSS

- Advertisement -

Resources