Embedding InfoPath form in email with VBA using SMTP/CDO

问题

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

回答1:

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

来源：https://stackoverflow.com/questions/18925065/embedding-infopath-form-in-email-with-vba-using-smtp-cdo

标签

vb.net

vba

vbscript

smtp

infopath