In a previous post I discussed the structure of Outlook 2003 Meeting requests. It turned out to be surprisingly hard to get incoming meeting requests show an Accept/Decline -dialog. This post continues from where the previous one left. The focus is on sending email with Microsoft Collaborative Object or CDO.
Below is a .NET 1.1 module to send email. As you can see, its design is old, but it does what it says. I think I found the function template from MSDN.
Meeting request related code begins at comment
'iCalendar -attachements
You can control body part encodings and MIME types much better than in System.Web.Mail. In order to get Accept/Decline dialog working I needed two IBodyPart objects. One for the iCalendar in message body and one for the same iCalendar object as attachment.
Imports System.IO
Imports CDO
Public Module CDOMail
Public Function Send(ByVal fromName As String, _
ByVal fromAddress As String, _
ByVal replyToAddress As String, _
ByVal toAddress As String, _
ByVal ccAddress As String, _
ByVal bccAddress As String, _
ByVal header As String, _
ByVal body As String, _
ByVal format As String, _
ByVal importance As String, _
ByVal smtpServer As String, _
ByVal attachments As ArrayList) As String
Dim ErrorMsg As String = ""
' Variable which will send the mail
Dim oMsg As CDO.Message = New CDO.Message
Try
Dim Counter As Integer = 0
' Set configuration.
Dim iConfg As CDO.Configuration = New CDO.Configuration
'CDO SMTP config fields
Const cdoSendUsingMethod As String = _
"http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSendUsingPort As Integer = 2
Const cdoSMTPServer As String = _
"http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPConnectionTimeout As String = _
"http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
' Other available settings
'Const cdoSMTPServerPort As String = _
'"http://schemas.microsoft.com/cdo/configuration/smtpserverport"
'Const cdoSMTPAuthenticate As String = _
'"http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
''Const cdoBasic = 1
'Const cdoSendUserName As String = _
'"http://schemas.microsoft.com/cdo/configuration/sendusername"
'Const cdoSendPassword As String = _
'"http://schemas.microsoft.com/cdo/configuration/sendpassword"
' Get a handle on the config object and it's fields
' Set necessary config fields
With iConfg.Fields
.Item(cdoSendUsingMethod).Value = cdoSendUsingPort
.Item(cdoSMTPServer).Value = smtpServer
.Item(cdoSMTPConnectionTimeout).Value = 10
.Update()
End With
oMsg.Configuration = iConfg
If smtpServer = "" Then Return "SMTP server is missing"
'Multiple recepients can be specified using ; as the delimeter
'Address of the recipient
oMsg.To = toAddress
oMsg.CC = ccAddress
oMsg.BCC = bccAddress
If toAddress = "" And ccAddress = "" And bccAddress = "" Then
ErrorMsg = "Recipient missing"
GoTo problem
End If
'Your From Address
'You can also use a custom header Reply-To for a different replyto address
If fromName <> "" Then
oMsg.From = "\" & fromName & "\ <" & fromAddress & ">"
Else
oMsg.From = fromAddress
End If
If oMsg.From = "" Then
ErrorMsg = "No sender"
GoTo problem
End If
'Specify the body format
If UCase(format) = "HTML" Then
oMsg.HTMLBody = body 'Send the mail in HTML Format
Else
oMsg.TextBody = body
End If
'If you want you can add a reply to header
If replyToAddress <> "" Then
oMsg.ReplyTo = replyToAddress
End If
' Message importance
Const cdoHigh As Integer = 2
'Const cdoNormal As Integer = 1
Const cdoLow As Integer = 0
If UCase(importance) = "HIGH" Then oMsg.Fields("urn:schemas:httpmail:importance").Value = cdoHigh
If UCase(importance) = "LOW" Then oMsg.Fields("urn:schemas:httpmail:importance").Value = cdoLow
'Mail Subject
oMsg.Subject = header
Dim attachment As String
For Each attachment In attachments
' iCalendar -attachements.
If InStr(attachment, ".ics") Then
' Mail content class
oMsg.Fields("urn:schemas:mailheader:content-class").Value = "urn:content-classes:calendarmessage"
oMsg.TextBody = body
oMsg.HTMLBody = Replace(body, vbCrLf, "")
Dim iBps As IBodyParts
iBps = oMsg.BodyPart.BodyParts
Dim iBp As CDO.IBodyPart 'iCalendar as text
iBp = iBps.Add
Dim AttachmentText As String
Dim oRead As System.IO.StreamReader
oRead = File.OpenText(attachment)
AttachmentText = oRead.ReadToEnd()
Dim Stm As ADODB.Stream
With iBp
.ContentMediaType = "text/calendar; method=REQUEST"
.ContentTransferEncoding = "7bit"
Stm = .GetDecodedContentStream
Stm.WriteText(AttachmentText)
Stm.Flush()
End With
Dim oBP As CDO.IBodyPart
oBP = oMsg.AddAttachment(attachment, "", "") 'iCalendar as an attachment
'Set ContentMediaType - vcs files need this setting.
oBP.ContentMediaType = "application/ics"
oBP.ContentTransferEncoding = "7bit"
Else
oMsg.AddAttachment(attachment, "", "") 'Other attachments
End If
Next
'Call the send method to send the mail
If oMsg.Subject = "" And body = "" Then
ErrorMsg = "Header and body are empty"
GoTo problem
End If
oMsg.Send()
oMsg = Nothing
iConfg = Nothing
Catch ex As Exception
ErrorMsg = ex.Message
GoTo problem
End Try
Return ""
Exit Function
problem:
Return ErrorMsg
End Function
End Module
Posts
