I am attempting to do the following:
Use VBA to generate SMTP email
Display InfoPath form embedded in email
This will be linked to an Access database
Unfortunately, I have not been able to configure the outgoing SMTP message correctly using CDO.
I have been building on information found in this post which unfortunately is in C# and some of this functionality doesn't directly map to VB/VBA. Specifically, the "Message.Headers" part is not a property the CDO.Message class has.
I have been able to change the attachments and add them correctly but while the following works:
.fields("urn:schemas:mailheader:Message-Class") = "IPM.InfoPathForm.InfoPath"
.fields("urn:schemas:mailheader:Content-Class") = "InfoPathForm.InfoPath"
the form is not displayed in the email (both the xml and xsn are appearing as attachments and NOT displaying as an embedded form).
In comparing email source between a valid form (generated manually) and invalid (generated proramatically) I have not been able to determine what else I must change. There are several more content tags in the emails, one is:
Content-Type: text/html; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable
<html dir=3D"ltr" id=3D"L044F61201A9E6BE2"> <head> <meta http-equiv=3D"Content-Type" content=3D"text/html; charset=3Diso-8859-= 1"> </head>
(etc, there is a bunch more)
and another is:
Content-Type: text/plain; charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
And under this there is text from the actual form.
Presumably these sections need to be generated automatically by some setting I am not using correctly.
Here is the code I am using to generate my emails. Note that the two attachments are valid and ones I saved off a form which does display correctly, when I use InfoPath to send the email.
Sub testSendingEmail()
On Error GoTo errHndlr 'boring error handling
Dim myAttach(1 To 2) As String
Dim myContentType(1 To 2) As String
myAttach(1) = "C:\Users\UserID\Desktop\infoPath\outlooksaves\Form1.xml"
myAttach(2) = "C:\Users\UserID\Desktop\infoPath\outlooksaves\Add Projects Table Form.xsn"
myContentType(1) = "application/x-microsoft-InfoPathForm"
myContentType(2) = "application/x-microsoft-InfoPathFormTemplate"
Dim mailMessage As Object
Set mailMessage = CreateObject("CDO.Message")
With mailMessage
.Subject = "Test Automatic Subject 363"
.from = "donotreply#a.com"
.To = "TestEmail#gmail.com"
.AddAttachment myAttach(1)
.AddAttachment myAttach(2)
.Attachments.Item(1).ContentMediaType = myContentType(1)
.Attachments.Item(2).ContentMediaType = myContentType(2)
'testing - this isn't right :(
.fields("urn:schemas:mailheader:Message-Class") = "IPM.InfoPathForm.InfoPath"
.fields("urn:schemas:mailheader:Content-Class") = "InfoPathForm.InfoPath"
With .Configuration.fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailserve"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'.Item("http://schemas.microsoft.com/cdo/configuration/mailheader:Content-Class") = "InfoPathForm.InfoPath"
.Update
End With
'.BodyPart.ContentClass = "InfoPathForm.InfoPath"
'from C# code
'.Headers.Add "Content-Class", "InfoPathForm.InfoPath"
' .Headers.Add "Message-Class", "IPM.InfoPathForm.InfoPath"
.Send
End With
Exit Sub
errHndlr:
Debug.Print "Error!" & " " & Err.Description
End Sub
I was able to get this working with one extra line. You need to add .fields.update after you add the headers.
This will not show the form in the preview unfortunately, but it will attach it as proper infopath form.
'testing - this isn't right :(
.fields("urn:schemas:mailheader:Message-Class") = "IPM.InfoPathForm.InfoPath"
.fields("urn:schemas:mailheader:Content-Class") = "InfoPathForm.InfoPath"
.fields.update 'Need to update the header fields
Related
The requirement is to upload attachments to a server. However, we only want to upload those appears in the "Message" line (see pic below) of outlook, nothing else in the email body.
Since Outlook itself knows which attachment should be show in the line, there must be information that it uses to distinguish them internally.
So, how can I do that within my VBA program? I have tried to use MailItem.Attachments but all attachments are there and I cannot find any property of them can be used to distinguish.
UPDATE
The original title "Distinguish embadded attachments with Outlook VBA" is a bit misleading. So I have changed the title.
Outlook Screenshot:
As I can test so far, an embedded attachment always have a MIME content ID, regardless whether it appears in the mail body. So the solution is to check whether it has a content ID.
Here is an example code that counts the visible attachments:
Sub ShowVisibleAttachmentCount()
Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
Dim m As MailItem
Dim a As Attachment
Dim pa As PropertyAccessor
Dim c As Integer
Dim cid as String
Dim body As String
c = 0
Set m = Application.ActiveInspector.CurrentItem
body = m.HTMLBody
For Each a In m.Attachments
Set pa = a.PropertyAccessor
cid = pa.GetProperty(PR_ATTACH_CONTENT_ID)
If Len(cid) > 0 Then
If InStr(body, cid) Then
Else
'In case that PR_ATTACHMENT_HIDDEN does not exists,
'an error will occur. We simply ignore this error and
'treat it as false.
On Error Resume Next
If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
c = c + 1
End If
On Error GoTo 0
End If
Else
c = c + 1
End If
Next a
MsgBox c
End Sub
When I run through all my outlook emails it gives the same number of attachments in the line.
UPDATE
Thanks to Dmitry Streblechenko's information, I tested Outlook with email generated by Java Email library. The result shows that when an email attachment contains an CID but not appear in the email body, it will appear in the attachments line.
UPDATE
It looks there are still some cases that this is not good enough.
I have generated the following MIME email body:
Message-ID: <1044564324.2.1360638429705.JavaMail.joe#xxxx>
Subject: Test
MIME-Version: 1.0
Content-Type: multipart/alternative;
boundary="----=_Part_0_1327112367.1360638429515"
Return-Path: xxxx#xxxx.xxx
X-OriginalArrivalTime: 12 Feb 2013 03:07:16.0096 (UTC) FILETIME=[0FC1B000:01CE08CE]
------=_Part_0_1327112367.1360638429515
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
TTT
------=_Part_0_1327112367.1360638429515
Content-Type: multipart/related;
boundary="----=_Part_1_1747887937.1360638429520"
------=_Part_1_1747887937.1360638429520
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
<html><head><meta http-equiv=3D'content-type' content=3D'text/html; charset=
=3DUTF-8'></head><title>TTT</title><body><img src=3D"cid:test1.png" alt=3D'=
=E6=81=AD=E8=B4=BA=E6=96=B0=E7=A6=A7' /><p>txt</p></body></html>
------=_Part_1_1747887937.1360638429520
Content-Type: image/png
Content-Transfer-Encoding: base64
Content-ID: <test.png>
iVBORw0KGgoAAAANSUhEUgAAAIIAAAAmCAYAAAAIjkMFAAABHUlEQVR42u3Z0Q7CIAyFYd//pafx
ckFoS9ELvz8aE9mQrIfTFh8PAAAAAPgp1+t1vT9i32fm6FzP6JrKb3aulRAGARm9Z9dUAhWZY7Wm
7Hr+IvhdD+s+PhLCLNBZQZ12HI7QlBqyQohctxM8bvAFIcx2eEYIo/vuY5WAi3BzWlhZ+if7zs7T
UWtE10Asgd3bUSxWHvrMobJOtXITQkjk5Z3gdaWaqBBWouYIhdy+E+TsPNHU0CUEbjDJ49GxE0KI
nBNUheAcYbPVy9QNmRaxUvVHd7Idf0gU2QDOduVqnkinoEb4QY1Q3V2RNrMqpB0h6BqKh0gZIWT/
AzjVycwcjSMcPI3buSebZiptaLbIBQAAAAAAAAAAAAAAAP6OJyO5jJ4bZa/gAAAAAElFTkSuQmCC
------=_Part_1_1747887937.1360638429520--
------=_Part_0_1327112367.1360638429515--
Notice that I have changed the referencing image content id in the body, and the actual image have a wrong content ID (so it is not referenced). However the image is not in the main part of the email (it is in a branch of an alternative part). That makes it invisible in outlook.
So to detect we have to make sure the attachment appears in the main MIME part... Looking for ways to do so.
UPDATE
Further digging I reaches this link and I added one more test - the PR_ATTACHMENT_HIDDEN property.
Also it is worth to say that outlook 2010 itself is not consistent. I have observed that sometimes the email list shows the attachment icon to indicate existence of attachments but there are nothing appear when opening it in an inspector.
References:
Sending Outlook Email with embedded image using VBS
MSDN - Attachment Properties
Forum - Identifying inline attachments
Based on answer by #Earth Engine , here it is a function returning the real number of attachments upon passing a mailitem (item.class = olMail) as parameter:
Function CountVisibleAttachment(ByVal m As MailItem) As Integer
Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
Dim a As Attachment
Dim pa As propertyAccessor
Dim c As Integer
Dim cid As String
Dim body As String
c = 0
body = m.HTMLBody
For Each a In m.Attachments
Set pa = a.propertyAccessor
cid = pa.GetProperty(PR_ATTACH_CONTENT_ID)
If Len(cid) > 0 Then
If InStr(body, cid) Then
emb = emb + 1
Else
'In case that PR_ATTACHMENT_HIDDEN does not exists,
'an error will occur. We simply ignore this error and
'treat it as false.
On Error Resume Next
If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
c = c + 1
End If
On Error GoTo 0
End If
Else
c = c + 1
End If
Next a
CountVisibleAttachment = c
End Function
Some attachments always have the MIME content id (PR_ATTACH_CONTENT_ID), in particular, messages from Lotus Notes always have that header.
The real test is to check the HTMLBody property and see if any attachments are actually referenced by the <img> tags. In addition. some attachments (e.g. some style files created by Outlook) are hidden by setting the PT_ATTACH_HIDDEN MAPI property
Redemption (I am its author) lets you distinguish attachments like that using the RDOAttachment.Hidden property.
I'm looking to forward email that I receive in Outlook to a new address with no changes - an exact clone, no envelope information nor signature added.
The email will always have an HTML table in the body and needs to be preserved identically. I can get it to forward but it always adds a blank email body with a signature "above" the original email, and then there is the standard From: and To: and email attributes above the original email.
Is there a way to remove this? I have tried to change this to generate a "new" object, as the new object is not bringing in the HTML body before forwarding.
Sub Send_Forward(ByRef oMail As Object, repBodyStr As String, sendMail As
Boolean)
Dim myForward As Object
Set myForward = oMail.Forward
myForward.Subject = myForward.Subject
myForward.HTMLBody = repBodyStr & "<br>" & myForward.HTMLBody
myForward.Recipients.Add "xxx#xxx.net"
myForward.Display
ExitSub:
Set myForward = Nothing
End Sub
Create a new item (Application.CreateItem), then just copy the HTMLBody property from the existing message and add the recipients.
UPDATE: if you need to copy the attachments (such as images), you would have to save the attachments from the original message (Attachment.SaveAsFile), then add them as attachments to the new message (MailItem.Attachments.Add). Note that this will not work with embedded OLE objects (in case of the RTF format) and embedded message attachments. For the images, you would also need to copy the PR_ATTACH_CONTENT_ID MAPI property using Attachment.PropertyAccessor.
Also note MailItem.Copy would not work as the message sent state will be copied (which his not what you want).
If using Redemption (I am its author) is an option, it allows to make a copy of the message without copying its sent state. Something like the following should do the job (off the top of my head):
Set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set originalMsg = Session.GetRDOObjectFromOutlookObject(Application.ActiveExplorer.Selection(1))
set newMsg = Session.GetDefaultFolder(olFolderDrafts).Items.Add
'copy the message and clear out recipients
originalMsg.CopyTo(newMsg)
newMsg.Recipients.Clear
newMsg.Recipients.Add "xxx#xxx.net"
newMsg.Save
'now reopen the message in OOM and diplay it. Or you can use newMsg.Display
set myForward = Application.Session.GetItemFromID(newMsg.EntryID)
myForward.Display
I have a web portal based upon a SQL database, that we use to update progress. When a record has been updated in the queue the web form is supposed to send an email message.
Currently the web portal is not sending the message, and I am not sure of the point of failure. The portal itself is being updated as I can see the updated record in the SQL table. Just not receiving the email.
Update 04/27/18
So I am trying to attack this from a new avenue, and it is working kind of....
What I have done, is sent the form off to an external website using php, and it will send an email.
What I am wondering is how can I pass variables? I have been reading instructions for an hour, and it just doesn't make sense to me.
Essentially I want to pass one variable from the following query
thequery = "SELECT loginemail FROM users WHERE referrerId = " & request.Form("referrerID") & ""
objRS.open thequery, objConn, adOpenStatic, adLockReadOnly
and then pass it with something like this
<form action="https://xxxxxx.com/hello.php?loginemail" method="post" name="updateclientform" id="updateclientform">
On the php form side send the email based upon the variable "loginemail"
$to = trim(objRS("loginemail"));
Anyone help? PLEASE
CDO may not be supported by MS anymore - like Classic ASP itself, but it still works. I would look into a setting up a script in your ASP application to send the mail using CDO. That way you can better control any SQL injection threats and manage the whole process in one place.
Here is an example CDO mail script.
<%
'* Declare mailobject variables.
Dim validEmail, email_to, objCDOMail, objConf
Sub SetMailObject()
'* set up CDO config
Set objConf=Server.CreateObject("CDO.Configuration")
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mysmtp.server.com"
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "myusername"
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
objConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objConf.Fields.Update
' Create an instance of the NewMail object.
Set objCDOMail = Server.CreateObject("CDO.Message")
Set objCDOMail.Configuration=objConf
End Sub
Sub sendLoginEmail(email_to)
'* Call Sub to set mail object settings
SetMailObject()
'* Set the mail objects
objCDOMail.From = "myadmin#mydomain.com"
objCDOMail.To = email_to
objCDOMail.Bcc = ""
objCDOMail.Subject = "My mail subject"
objCDOMail.TextBody = "My email body"
'* Send the message
objCDOMail.Send
'* Set the object to nothing
Set objCDOMail = Nothing
End Sub
If Request("loginemail") <> "" Then
validEmail = Request("loginemail")
'* strongly suggest to perform some cleansing and validation of the email here
Call sendLoginEmail(validEmail)
End If
%>
The requirement is to upload attachments to a server. However, we only want to upload those appears in the "Message" line (see pic below) of outlook, nothing else in the email body.
Since Outlook itself knows which attachment should be show in the line, there must be information that it uses to distinguish them internally.
So, how can I do that within my VBA program? I have tried to use MailItem.Attachments but all attachments are there and I cannot find any property of them can be used to distinguish.
UPDATE
The original title "Distinguish embadded attachments with Outlook VBA" is a bit misleading. So I have changed the title.
Outlook Screenshot:
As I can test so far, an embedded attachment always have a MIME content ID, regardless whether it appears in the mail body. So the solution is to check whether it has a content ID.
Here is an example code that counts the visible attachments:
Sub ShowVisibleAttachmentCount()
Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
Dim m As MailItem
Dim a As Attachment
Dim pa As PropertyAccessor
Dim c As Integer
Dim cid as String
Dim body As String
c = 0
Set m = Application.ActiveInspector.CurrentItem
body = m.HTMLBody
For Each a In m.Attachments
Set pa = a.PropertyAccessor
cid = pa.GetProperty(PR_ATTACH_CONTENT_ID)
If Len(cid) > 0 Then
If InStr(body, cid) Then
Else
'In case that PR_ATTACHMENT_HIDDEN does not exists,
'an error will occur. We simply ignore this error and
'treat it as false.
On Error Resume Next
If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
c = c + 1
End If
On Error GoTo 0
End If
Else
c = c + 1
End If
Next a
MsgBox c
End Sub
When I run through all my outlook emails it gives the same number of attachments in the line.
UPDATE
Thanks to Dmitry Streblechenko's information, I tested Outlook with email generated by Java Email library. The result shows that when an email attachment contains an CID but not appear in the email body, it will appear in the attachments line.
UPDATE
It looks there are still some cases that this is not good enough.
I have generated the following MIME email body:
Message-ID: <1044564324.2.1360638429705.JavaMail.joe#xxxx>
Subject: Test
MIME-Version: 1.0
Content-Type: multipart/alternative;
boundary="----=_Part_0_1327112367.1360638429515"
Return-Path: xxxx#xxxx.xxx
X-OriginalArrivalTime: 12 Feb 2013 03:07:16.0096 (UTC) FILETIME=[0FC1B000:01CE08CE]
------=_Part_0_1327112367.1360638429515
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
TTT
------=_Part_0_1327112367.1360638429515
Content-Type: multipart/related;
boundary="----=_Part_1_1747887937.1360638429520"
------=_Part_1_1747887937.1360638429520
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: quoted-printable
<html><head><meta http-equiv=3D'content-type' content=3D'text/html; charset=
=3DUTF-8'></head><title>TTT</title><body><img src=3D"cid:test1.png" alt=3D'=
=E6=81=AD=E8=B4=BA=E6=96=B0=E7=A6=A7' /><p>txt</p></body></html>
------=_Part_1_1747887937.1360638429520
Content-Type: image/png
Content-Transfer-Encoding: base64
Content-ID: <test.png>
iVBORw0KGgoAAAANSUhEUgAAAIIAAAAmCAYAAAAIjkMFAAABHUlEQVR42u3Z0Q7CIAyFYd//pafx
ckFoS9ELvz8aE9mQrIfTFh8PAAAAAPgp1+t1vT9i32fm6FzP6JrKb3aulRAGARm9Z9dUAhWZY7Wm
7Hr+IvhdD+s+PhLCLNBZQZ12HI7QlBqyQohctxM8bvAFIcx2eEYIo/vuY5WAi3BzWlhZ+if7zs7T
UWtE10Asgd3bUSxWHvrMobJOtXITQkjk5Z3gdaWaqBBWouYIhdy+E+TsPNHU0CUEbjDJ49GxE0KI
nBNUheAcYbPVy9QNmRaxUvVHd7Idf0gU2QDOduVqnkinoEb4QY1Q3V2RNrMqpB0h6BqKh0gZIWT/
AzjVycwcjSMcPI3buSebZiptaLbIBQAAAAAAAAAAAAAAAP6OJyO5jJ4bZa/gAAAAAElFTkSuQmCC
------=_Part_1_1747887937.1360638429520--
------=_Part_0_1327112367.1360638429515--
Notice that I have changed the referencing image content id in the body, and the actual image have a wrong content ID (so it is not referenced). However the image is not in the main part of the email (it is in a branch of an alternative part). That makes it invisible in outlook.
So to detect we have to make sure the attachment appears in the main MIME part... Looking for ways to do so.
UPDATE
Further digging I reaches this link and I added one more test - the PR_ATTACHMENT_HIDDEN property.
Also it is worth to say that outlook 2010 itself is not consistent. I have observed that sometimes the email list shows the attachment icon to indicate existence of attachments but there are nothing appear when opening it in an inspector.
References:
Sending Outlook Email with embedded image using VBS
MSDN - Attachment Properties
Forum - Identifying inline attachments
Based on answer by #Earth Engine , here it is a function returning the real number of attachments upon passing a mailitem (item.class = olMail) as parameter:
Function CountVisibleAttachment(ByVal m As MailItem) As Integer
Const PR_ATTACH_CONTENT_ID As String = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Const PR_ATTACHMENT_HIDDEN As String = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
Dim a As Attachment
Dim pa As propertyAccessor
Dim c As Integer
Dim cid As String
Dim body As String
c = 0
body = m.HTMLBody
For Each a In m.Attachments
Set pa = a.propertyAccessor
cid = pa.GetProperty(PR_ATTACH_CONTENT_ID)
If Len(cid) > 0 Then
If InStr(body, cid) Then
emb = emb + 1
Else
'In case that PR_ATTACHMENT_HIDDEN does not exists,
'an error will occur. We simply ignore this error and
'treat it as false.
On Error Resume Next
If Not pa.GetProperty(PR_ATTACHMENT_HIDDEN) Then
c = c + 1
End If
On Error GoTo 0
End If
Else
c = c + 1
End If
Next a
CountVisibleAttachment = c
End Function
Some attachments always have the MIME content id (PR_ATTACH_CONTENT_ID), in particular, messages from Lotus Notes always have that header.
The real test is to check the HTMLBody property and see if any attachments are actually referenced by the <img> tags. In addition. some attachments (e.g. some style files created by Outlook) are hidden by setting the PT_ATTACH_HIDDEN MAPI property
Redemption (I am its author) lets you distinguish attachments like that using the RDOAttachment.Hidden property.
I am writing an outlook sub procedure that takes the currently selected email, parses it, and creates a new email message. The parsing is simple enough: Extract the email addresses from the first line of the message and then the rest of the body is the regular email body in the new message.
I am using this basic code for setting the body of the new message:
Set newMsg = Outlook.Application.CreateItem(olMailItem)
With newMsg
.BodyFormat = olFormatHTML
.Body = newBody
'... set subject,etc
.Display
The problem is that the new message that is created loses all of the HTML formatting that the message I was copying the information from possessed ( and various font stylings). I tried setting the new message's body format to HTML (see code above), but that did not do the trick. Currently, the new message contains all of the textual data, but instead of the table, each cell's data is tab-delimited and the entire message body is in the same font.
BodyFormat does not behave as expected. Instead, HTMLBody can be used as below to properly display the body in HTML format:
With newMsg
.HTMLBody = newBody
'... set subject,etc
.Display