HOWTO: Send Email With Attachment Using VB and WebDAV
To send an email with WebDAV, you will you will need to create/recreate the item with a WEBDAV PUT using the MIME of the message. It gets tricky when working with attachments. To get around the complexity of sending an email with an attachment, you may want to look at using CDOSYS to build the message to send, then extract the MIME stream (MIME of the message in a string) of the resulting message.
For sending the message, you would use a PUT statement to write the stream to a file in the Drafts folder of the sending person’s mail box. If you need to set specific properties not set by the MIME, you should do a PROPPATCH against the message in the Drafts folder. Next, the code should use a WebDAV MOVE in order to place the message into the mailbox’s submission URL. The Submission URL is a special url used for sending messages. “/##DavMailSubmissionURI##" off of the root of the mailbox is the Submission URL.
' TODO:
' Create a VB Windows program.
' Add a button to the form
' Add references to:
' Active X Data Objectes
' Microsoft CDO for Windows 2000 Library
' Microsoft XML, 3.0
' Paste-in the code below.
' Do the TODO sections in the code.
Option Explicit
Private Sub Command1_Click()
CreateMessageAndWebDAVSubmit
End Sub
'-----------------------------------------------------------------------------------
' CreateMessageAndWebDAVSubmit - Main method for generating message and using WEBDAV
' to send the message.
'-----------------------------------------------------------------------------------
Private Sub CreateMessageAndWebDAVSubmit()
Dim sDraftsFolder As String
Dim sSubmissionURL As String
Dim strAttendeeItem As String
Dim dateNow As Date
Dim strMIMEStream As String
Dim bRet As Boolean
Dim sUser As String
Dim sPassword As String
' TODO: Change username and password or set to "" if using windows authentication
sUser = "Administrator" ' TODO: Change
sPassword = "testpassword" ' TODO: Change
' TODO: Change the Drafts folder and submission URLs
sDraftsFolder = "https://myexserver/exchange/Administrator/Drafts/SubmittedMail" & GetUniqueString & ".EML" ' TODO: Change this
sSubmissionURL = "https://myexserver/exchange/Administrator/##DavMailSubmissionURI##" ' TODO: Change this
' Use CDOSYS to generate the message body parts and such
strMIMEStream = BuildMessageAndGenerateMIMEStream()
bRet = DoWebdavPut(sDraftsFolder, strMIMEStream, sUser, sPassword)
If (bRet = True) Then
' NOTE:
' At this point, the email is in the drafts folder. If you don't want it sent
' automatically, you can comment out the line below. If the line below does not
' execute, you can load the message from Outlook or OWA and send it from there.
DoWebdavCopyMove sDraftsFolder, sSubmissionURL, False, sUser, sPassword ' MOVE IT TO SUBMISSION !!!
End If
End Sub
'-----------------------------------------------------------------------------------
' BuildMessageAndGenerateMIMEStream - This will create a CDOSYS message, attach a file
' and return the Mime stream for use with webdav.
'-----------------------------------------------------------------------------------
Private Function BuildMessageAndGenerateMIMEStream() As String
Dim oBodyPart As CDO.IBodyPart
Dim oMessage As CDO.Message
Dim oConfig As CDO.Configuration
Dim oFields As ADODB.Fields
Dim sFile As String
Dim strMIMEStream As String
Dim oAttachStream As ADODB.Stream
Dim oMIMEStream As ADODB.Stream
Set oMessage = New CDO.Message
Set oConfig = New CDO.Configuration
Set oFields = oConfig.Fields
With oMessage
Set .Configuration = oConfig
.To = "Administrator@mydomain.extest.microsoft.com" ' TODO: Change to the name of the sender
.From = "Administrator@mydomain.extest.microsoft.com" ' TODO: Change to the name the person the mail is going to
.Subject = "Test" ' TODO: Change to the subject of the message.
.TextBody = "Test adding icon" ' TODO: Change to the body of the message.
.Fields.Update
End With
' The File I'm attaching
sFile = "C:\output.txt" ' TODO: Change to the name of the file being sent.
Set oBodyPart = oMessage.AddAttachment(sFile, "", "") ' Do Attatchment
' NOTE: For your reference...
'With oBodyPart
' ' Set the content class appropriately
' '.ContentMediaType = "mage/x-icon" '"text/html"
' ' Get the decoded content stream so we can use it
' Set oAttachStream = .GetDecodedContentStream()
'End With
' Now get the entire message stream
Set oMIMEStream = oMessage.GetStream()
' Read the text out of it
strMIMEStream = oMIMEStream.ReadText()
Set oMIMEStream = Nothing
Set oAttachStream = Nothing
Set oBodyPart = Nothing
Set oMessage = Nothing
' And return it
BuildMessageAndGenerateMIMEStream = strMIMEStream
End Function
'-----------------------------------------------------------------------------------
' GetUniqueString - Used to generate a fairly unique string... used in making a
' Unique file name. This is: Datetime + random + serial value
'-----------------------------------------------------------------------------------
Private Function GetUniqueString() As String
' I'm in EST, which is GMT - 5, but it's Daylight Savings, to it becomes GMT - 4
Const TimeZoneOffset As Long = 4
Dim sString As String
Dim dateNow As Date
Dim iRnd As Single
Dim lNum As Long
Static lVal As Long
lVal = lVal + 1
If lVal > 50000 Then lVal = 1
iRnd = Rnd(CLng(Format(Now, "mmhhmmss")))
lNum = CLng(iRnd * 10000000)
dateNow = DateAdd("h", TimeZoneOffset, Now())
sString = Format(dateNow, "yyyyMMdd") & "T" & Format(dateNow, "HHmmss") & "Z"
GetUniqueString = sString & CStr(lNum) & lVal ' Datetime + random + serial value
End Function
'-----------------------------------------------------------------------------------
' DoCopyMove - Used to PUT (write) an item to a file in a folder.
' sFolder - The complete URI to PUT the item (includes item name).
' sText - The contents to write in the file.
' sUser - User ID for logging in. Set to "" if using windows authentication
' sPassword - Password for logging in. Set to "" if using windows authentication
'-----------------------------------------------------------------------------------
Private Function DoWebdavPut(sFolder As String, sText As String, sUser As String, sPassword As String) As Boolean
Dim oXMLHttp As New MSXML2.XMLHTTP30
Dim bSucess As Boolean
Dim iStatus As Integer
Dim sStatus As String
Dim sResponse As String
If sUser <> "" Then
oXMLHttp.Open "PUT", sFolder, False, sUser, sPassword ' TODO: Change username and password
Else
oXMLHttp.Open "PUT", sFolder, False ', sUser, sPassword ' TODO: Change username and password
End If
oXMLHttp.setRequestHeader "translate", "f" ' Set this header to prevent DAV from trying to munge our stream
oXMLHttp.Send sText ' Send the stream across
bSucess = False
iStatus = oXMLHttp.Status
sStatus = oXMLHttp.statusText
If (iStatus >= 200 And iStatus < 300) Then
Debug.Print "PUT: Success! " & "Results = " & iStatus & ": " & sStatus
bSucess = True
ElseIf iStatus = 401 Then
Debug.Print "PUT: You don't have permission to do the job! Please check your permissions on this item."
Else
Debug.Print "PUT: Request Failed. Results = " & iStatus & ": " & sStatus
End If
Set oXMLHttp = Nothing
DoWebdavPut = bSucess
End Function
'-----------------------------------------------------------------------------------
' DoCopyMove - Used to move an item from one folder to another in the same store.
' sSourceURL - item being moved/copied
' sDestinationURL - the URL it is going to
' bCopy - TRUE if copying or FALSE if moving
' sUser - User ID for logging in. Set to "" if using windows authentication
' sPassword - Password for logging in. Set to "" if using windows authentication
'-----------------------------------------------------------------------------------
Private Sub DoWebdavCopyMove(ByVal sSourceURL As String, ByVal sDestinationURL As String, ByVal bCopy As Boolean, sUser As String, sPassword As String)
Dim oXMLHttp As New MSXML2.XMLHTTP30
Dim sVerb As String
If bCopy Then
sVerb = "COPY"
Else
sVerb = "MOVE"
End If
If sUser <> "" Then
oXMLHttp.Open sVerb, sSourceURL, False, sUser, sPassword ' TODO: Change username and password
Else
oXMLHttp.Open sVerb, sSourceURL, False ', sUser, sPassword ' TODO: Change username and password
End If
oXMLHttp.setRequestHeader "Destination", sDestinationURL
' Send the stream across
oXMLHttp.Send
If (oXMLHttp.Status >= 200 And oXMLHttp.Status < 300) Then
Debug.Print "Success! " & "Results = " & oXMLHttp.Status & ": " & oXMLHttp.statusText
ElseIf oXMLHttp.Status = 401 Then
Debug.Print "You don't have permission to do the job!
Else
Debug.Print "Request Failed. Results = " & oXMLHttp.Status & ": " & oXMLHttp.statusText
End If
Set oXMLHttp = Nothing
End Sub
Comments
Anonymous
June 04, 2008
PingBack from http://luisspace.gigazu.com/vbscripttosendattachmentemail.htmlAnonymous
November 14, 2010
The comment has been removedAnonymous
November 14, 2010
Yes, it should work fine and the conversion from vb to vbscript should not be hard. There are other samples on my blog which show similar code using vbscript. blogs.msdn.com/.../howto-webdav-put-using-vbscript.aspx is an example.Anonymous
June 28, 2011
Hi, Thanks for the post! How would I know, what is the DAVSubmissionURL?Anonymous
June 29, 2011
Hi Bill; The submission URL is a pseudo URL used for submitting messages for transport. You won't be able to browse to it. When a message is moved to that folder, WebDAV will do an Exchange submission for transport of the message. The URL would be the URL of your mailbox + "##DavMailSubmissionURI##". The example above shows the submission URL for an Administrator Account. Note that its best to URL encode the # characters (%23). When sending email via WebDav, the best practice is to create the message in the drafts folder (Using PROPPATCH/PUT/PUT+PROPPATCH) and then moving the final version of the message to the submision URL.