使用SMTP / CDO在使用VBA的电子邮件中嵌入InfoPath表单

时间:2013-09-20 20:11:54

标签: vb.net vba vbscript smtp infopath

我正在尝试执行以下操作:

  • 使用VBA生成SMTP电子邮件
  • 显示嵌入在电子邮件中的InfoPath表单
    • 这将链接到Access数据库

不幸的是,我无法使用CDO正确配置外发SMTP邮件。

我一直在this post中找到的信息,不幸的是它在C#中,而且其中一些功能并没有直接映射到VB / VBA。具体来说,“Message.Headers”部分不是CDO.Message类具有的属性。

我已经能够更改附件并正确添加它们,但以下情况有效:

    .fields("urn:schemas:mailheader:Message-Class") = "IPM.InfoPathForm.InfoPath"
    .fields("urn:schemas:mailheader:Content-Class") = "InfoPathForm.InfoPath"

表单未显示在电子邮件中(xml和xsn都显示为附件,不显示为嵌入表单)。

在比较有效表单(手动生成)和无效表示(按比例生成)之间的电子邮件来源时,我无法确定我必须更改的内容。电子邮件中还有几个内容标签,其中一个是:

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)

另一个是:

Content-Type: text/plain; charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

在此之下,实际表格中有文字。

据推测,这些部分需要通过正确使用 的某些设置自动生成。

以下是我用来生成电子邮件的代码。请注意,当我使用InfoPath发送电子邮件时,这两个附件是有效的,我保存的表格是正确显示的表单。

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 个答案:

答案 0 :(得分:1)

我能够通过一条额外的线来完成这项工作。添加标题后,您需要添加.fields.update。

不幸的是,这不会在预览中显示该表单,但会将其作为正确的infopath表单附加。

    '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