无法通过Sendgrid API v3发送PDF附件，只能发送Base64中的文件名

Question

我正在尝试使用Sendgrid v3 API发送邮件，使用模板、个人数据和一个或多个附件。我已经为这个附件烦恼了好几天了，似乎绕不开将PDF编码成JSON并包含PDF的全部内容的问题。当我测试的时候，我会收到邮件，并且有一个附件。但是只有400字节，Adobe认为它是不可读的。在文本编辑器中打开时，PDF包含文件名。“所以，很接近，但没有雪茄...”

以下是我的代码，去掉了API密钥：

<%
Session.LCID=1053
dagen = FormatDateTime(Now,2)
bilaga1 = "D:\\www5.volvobil.net\KC-Admin-sg\docs\bilaga13.pdf"

Function ReadFile(sfilepath)
    Const adTypeText = 2
    Const adTypeBinary = 1
    Set B64Code = CreateObject("ADODB.Stream")
    b64Code.Open
    testCode = b64Code.LoadFromFile(sfilepath)
      b64Code.Position = 0
      b64Code.Type = adTypeText
      b64Code.CharSet = "us-ascii"
        dim bd
      bd = b64Code.ReadText
      B64Code.Close
      ReadFile = Base64Encode(bd)
End Function

Function Base64Encode(sText)
  Dim oXML, oNode
  Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
  Set oNode = oXML.CreateElement("base64")
  oNode.dataType = "bin.base64"
  oNode.nodeTypedValue = Stream_StringToBinary(sText)
  Base64Encode = oNode.text
  Set oNode = Nothing
  Set oXML = Nothing
End Function

Function Base64Decode(ByVal vCode)
  Dim oXML, oNode
  Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
  Set oNode = oXML.CreateElement("base64")
  oNode.dataType = "bin.base64"
  oNode.text = vCode
  Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
  Set oNode = Nothing
  Set oXML = Nothing
End Function

Private Function Stream_StringToBinary(Text)
  Const adTypeText = 2
  Const adTypeBinary = 1
  Dim BinaryStream 'As New Stream
  Set BinaryStream = CreateObject("ADODB.Stream")
  BinaryStream.Type = adTypeText
  BinaryStream.CharSet = "us-ascii"
  BinaryStream.Open
  BinaryStream.WriteText Text
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeBinary
  BinaryStream.Position = 0
  Stream_StringToBinary = BinaryStream.Read
  Set BinaryStream = Nothing
End Function

Private Function Stream_BinaryToString(Binary)
  Const adTypeText = 2
  Const adTypeBinary = 1
  Dim BinaryStream 'As New Stream
  Set BinaryStream = CreateObject("ADODB.Stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Open
  BinaryStream.Write Binary
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeText
  BinaryStream.CharSet = "us-ascii"
  Stream_BinaryToString = BinaryStream.ReadText
  Set BinaryStream = Nothing
End Function

toppbilden = "<img src=https://static.volvobil.se/images/mailutskick/600_header2_island.jpg alt=head border=0 />"
mailrubrik = "Byte av bil / Replacement of Car"
rubriken = "VÄLKOMMEN ATT BYTA DIN BIL"
enrubriken = "Welcome to replace your car (English version below)"


portalen = "<A HREF=https://intranet.volvocars.net/volvo-car-group/hr-portal/Pages/Company-cars-general-information-Sweden-Swedish.aspx>My Employment</A>"
portalenen = "<a href=https://intranet.volvocars.net/volvo-car-group/hr-portal/Pages/Company-cars-general-information-Sweden.aspx>My Employment</a>"

template = "d-3be42a9ce1db4461b2f72256fbb198eb"

    filen = ReadFile(bilaga1)
    filename = "bilaga13.pdf"

Response.Write "Filenamn = "& filename &" Fil = "& filen

    data = "{""from"":{""email"":""norepy@volvobil.se""},""personalizations"":[{""to"":[{""email"":"""& epost &"""}],""dynamic_template_data"":{""receipt"":true,""name"":"""& namnet &""",""hallen"":"""& hallen &""",""regno"":"""& regno &""",""oldregno"":"""& oldregno &""",""bilen"":"""& bilen &""",""dagtiden"":"""& dagtiden &""",""levgubbe"":"""& levgubbe &"""}}],""attachments"": [{""content"": """& filen &""",""filename"":"""& filename &""",""type"":""application/pdf""}],""template_id"":"""& template &"""}"
    link = "https://api.sendgrid.com/v3/mail/send"

    Dim oXMLHTTP
    Set oXMLHTTP = CreateObject("Msxml2.ServerXMLHTTP.6.0")
    if oXMLHTTP is nothing then Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")

    oXMLHTTP.Open "POST", link, False
    oXMLHTTP.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
    oXMLHTTP.setRequestHeader "Authorization", "Bearer <API-key>"

oXMLHTTP.send data

If oXMLHTTP.Status = 200 Then
PostData = oXMLHTTP.responseText
Else
response.Write "Status: " & oXMLHTTP.Status & " | "
response.Write oXMLHTTP.responseText

End If

SET oXMLHTTP = NOTHING

SET FormConad = NOTHING

Set objFSO = Nothing
Set objFileOut = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing

%>

输出是网页上的base64代码和来自Sendgrid的状态: 400 |{“错误”：{“消息”：“错误请求”，“字段”：null，“帮助”：null}}。

附件没有问题，我已经试过几次了。

我将非常感谢您的意见。

谢谢,

哈斯

Answer 1

看起来像是将文件内容流式传输为文本而不是二进制。

总结一下；

1. bilaga1变量不应包含D:\\，因为这可能会导致LoadFromFile()方法出错。它应该是有效的文件路径。
2. PDF不是文本文件，因此ADODB.Stream应该使用adTypeBinary而不是PDF。

作为附注：

这是我为不久前构建的一个SendGrid库编写的函数，应该可以让你对如何添加附件有所了解。

Sub AddMailAttachment(path, contenttype, disposition, filename, id)
    Dim json: json = ""
    Dim attachment, data

    If Not IsEmpty(path) Then
      If Left(path & "", 4) = "http" Then
        Dim xhr: Set xhr = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
        With xhr
          Call .Open("GET", path, False)
          Call .Send()
          If .Status = 200 Then
            data = .ResponseBody
          End If
        End With
      Else
        Dim fso: Set fso = Server.CreateObject("Scripting.FileSystemObject")
        Dim stream: Set stream = Server.CreateObject("ADODB.Stream")
        If fso.FileExists(path) Then
          With stream
            Call .Open()
            .Type = adTypeBinary
            Call .LoadFromFile(path)
            data = .Read()
          End With
        End If
      End If
      Dim contentid: contentid = Empty
      Set attachment = New MailAttachment
      If LCase(Trim(disposition & "")) = "inline" Then contentid = id
      Call attachment.Create(data, contenttype, disposition, filename, contentid)
      Call m_attachments.Add(attachment.Id, attachment)
    End If
End Sub

代码是类的一部分，因此一些元素，如m_attachments (它是一个存储类附件的Scripting.Dictionary )将不能从这个示例中访问。这个想法是为了向您展示应该如何实现ADODB.Stream。

下面是MailAttachment类。

Class MailAttachment
  Private m_id
  Private m_contentid
  Private m_content
  Private m_contenttype
  Private m_dispoition
  Private m_filename
  Private m_contentlength

  Public Property Get Id
    Id = m_Id
  End Property

  Public Property Get ContentId
    ContentId = m_contentid
  End Property

  Public Property Get Content
    Content = m_content
  End Property

  Public Property Get ContentType
    ContentType = m_contenttype
  End Property

  Public Property Get Disposition
    Disposition = m_dispoition
  End Property

  Public Property Get FileName
    FileName = m_filename
  End Property

  Public Property Get Size
    Size = m_contentlength
  End Property

  Private Sub Class_Initialize()

  End Sub

  Private Function ToBase64(rabyt)
    Dim xml: Set xml = CreateObject("MSXML2.DOMDocument.3.0")
    xml.LoadXml "<root />"
    xml.documentElement.dataType = "bin.base64"
    xml.documentElement.nodeTypedValue = rabyt

    ToBase64 = Replace(xml.documentElement.Text, vbLf, "")
  End Function

  Public Sub Create(content, contenttype, disposition, filename, contentid)
    m_id = CreateGuidPlainFormat()
    m_contentid = contentid
    m_contentlength = LenB(content)
    m_content = ToBase64(content)
    m_contenttype = contenttype
    m_dispoition = disposition
    m_filename = filename
  End Sub
End Class

Answer 2

这实际上是有效的(来自Base64 Encode a ZIP file using Classic ASP and VB Script的提示)和来自https://www.motobit.com/的函数。

但是，它需要很长时间，并且只能管理小文件，否则它将超时。

下面是当前的代码：

         Function Base64Encode(inData)
      Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
      Dim cOut, sOut, I

      For I = 1 To Len(inData) Step 3
        Dim nGroup, pOut, sGroup

        nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
          &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))

        nGroup = Oct(nGroup)

        nGroup = String(8 - Len(nGroup), "0") & nGroup

        pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
          Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
          Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
          Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)

        sOut = sOut + pOut

      Next
      Select Case Len(inData) Mod 3
        Case 1: 
          sOut = Left(sOut, Len(sOut) - 2) + "=="
        Case 2: 
          sOut = Left(sOut, Len(sOut) - 1) + "="
      End Select
      Base64Encode = sOut
    End Function

    Function MyASC(OneChar)
      If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
    End Function

    Function BinaryToString(Binary)
      Dim I, S
      For I = 1 To LenB(Binary)
        S = S & Chr(AscB(MidB(Binary, I, 1)))
      Next
      BinaryToString = S
    End Function

    Dim objStream, strFileText
    Set objStream = Server.CreateObject("ADODB.Stream")
    objStream.Type = 1
    objStream.Open
    objStream.LoadFromFile Server.MapPath(bilaga1)

    strFileText = Base64Encode(BinaryToString(objStream.Read))
    Response.Write strFileText

    objStream.Close
    Set objStream = Nothing