SendGrid Attachments Are Empty or Corrupt Using AP

问题:

This seems to be a constant issue with the SendGrid Web API and emailing attachments. I've found many, many posts across the web all of whom are having this same issue... but none of them seem to be answered with a solution. SendGrid's own canned response is use one of their libraries... but the question remains how do you attach files when you are using a language that does not have a library.

I've tried contacting SendGrid support myself on this issue... even offered to pay for support to get an answer but they thought I was asking for a "code review" which I wasn't. The question is simply this: What is needed to upload attachments to the SendGrid Web API.

I previously used to just provide the file location within the suggested API format as seen here: Previous Example of Posting to SendGrid Using VBA and this seemed to work fine for a while for myself and several others... but lately something has changed. Providing a simple file path no longer seems to work. So what do I need to do now? Should I encode the file? If so what encoding should I use base64? Any help in this would be greatly appreciated by me and many others!!

Here is my base64 attempt but it is having the same issue as my previous file path attempts i.e. the attachment shows in the email... but it can not be opened.

Private Sub SendEmail()
    Dim rs As DAO.Recordset
    Dim SQL As String
    Dim byteData() As Byte
    Dim xmlhttp As Object
    Dim eTo As String
    Dim eFrom As String
    Dim eBody As String
    Dim eSubject As String
    Dim eToName As String
    Dim HttpReq As String
    Dim ePass As String
    Dim eUser As String
    Dim strXML As String
    Dim strAttachments As String
    Dim strBase64 As String



    eSubject = Me.txtSubject
    eBody = Me.txtMessage
    eFrom = SenderEmail
    eUser = SendGridUser
    ePass = SendGridPass

    ' If Groups List/ Else Contacts List
    If Me.chkGroups <> 0 Then
        SQL = "SELECT * FROM qryContactsInSelectedGroups WHERE ContactType = 'Email'"
    Else
        SQL = "SELECT * FROM qrySelectedContacts WHERE ContactType = 'Email'"
    End If
    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges)

    If Not (rs.EOF And rs.BOF) Then
        rs.MoveFirst
        Do Until rs.EOF = True
            eTo = rs.Fields("ContactValue").Value
            eToName = rs.Fields("FirstName").Value & " " & rs.Fields("LastName").Value

              ' Set the Server URL to the form input
            HttpReq = "https://api.sendgrid.com/api/mail.send.xml?" _
            & "api_user=" & eUser _
            & "&api_key=" & ePass _
            & "&to=" & eTo _
            & "&toname=" & eToName _
            & "&subject=" & eSubject _
            & "&text=" & eBody _
            & "&from=" & eFrom _
            & GetAttachments()
            ' files[file1.jpg]=file1.jpg&files[file2.pdf]=file2.pdf
            Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
           ' adoStream.Position = 0
            xmlhttp.Open "POST", HttpReq, False
            xmlhttp.send

            byteData = xmlhttp.responseBody

            Set xmlhttp = Nothing
            strXML = StrConv(byteData, vbUnicode)
            Call EmailResponse(strXML, rs.Fields("ContactID").Value)
            Debug.Print strXML
            rs.MoveNext
        Loop
    End If
    Set rs = Nothing
End Sub

    Private Function GetAttachments() As String
    Dim rs As DAO.Recordset
    Dim SQL As String
    Dim currentAttachment As String
    Dim strAttachments As String
    Dim Encoded64 As String

    SQL = "SELECT * FROM tblMessageAttachments WHERE [MessageID] = " & MessageID
    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges)

    If Not (rs.EOF And rs.BOF) Then
        rs.MoveFirst
        Do Until rs.EOF = True
            ' Set Current Attachment
            currentAttachment = rs.Fields("AttachmentLocation").Value & rs.Fields("AttachmentName").Value
            Encoded64 = EncodeFile(currentAttachment)
            strAttachments = strAttachments & "&files" & Chr(91) & rs.Fields("AttachmentName").Value & Chr(93) & "=" & Encoded64 'currentAttachment
            'strAttachments = strAttachments & Encoded64
           ' Debug.Print strAttachments

            rs.MoveNext
        Loop
        Debug.Print strAttachments
        GetAttachments = strAttachments
    End If

End Function

Private Function EncodeFile(text As String) As String
  Dim arrData() As Byte
  arrData = StrConv(text, vbFromUnicode)

  Dim objXML As MSXML2.DOMDocument
  Dim objNode As MSXML2.IXMLDOMElement

  Set objXML = New MSXML2.DOMDocument
  Set objNode = objXML.createElement("b64")

  objNode.DataType = "bin.base64"
  objNode.nodeTypedValue = arrData
  EncodeFile = Replace(objNode.text, vbLf, "")

  Set objNode = Nothing
  Set objXML = Nothing

End Function

回答1:

This code has some additional code and logic to attach multiple attachments:

Option Explicit

Sub SendEmailUsingSendGrid()
    Dim HttpReqURL As String: HttpReqURL = "https://api.sendgrid.com/api/mail.send.json"

    Const adSaveCreateNotExist = 1
    Const adSaveCreateOverWrite = 2
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeReadWrite = 3

    Dim YOUR_SG_CREDS_USERNAME As String
    YOUR_SG_CREDS_USERNAME = "username"

    Dim YOUR_SG_CREDS_PASSWORD As String
    YOUR_SG_CREDS_PASSWORD = "password"

    Dim multiPartUploadBoundary As String
    multiPartUploadBoundary = "123456789abc"

    Dim eTo As String
    eTo = "[e-mail]"

    Dim eToName As String
    eToName = "To Name"

    Dim eSubject As String
    eSubject = "My Subject"

    Dim eBody As String
    eBody = "This is a test!"

    Dim eFrom As String
    eFrom = "[e-mail]"

    Dim outputStream As Object
    Set outputStream = CreateObject("adodb.stream")
    outputStream.Type = adTypeText
    outputStream.Mode = adModeReadWrite
    outputStream.charset = "windows-1252"
    outputStream.Open

    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "api_user", YOUR_SG_CREDS_USERNAME
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "api_key", YOUR_SG_CREDS_PASSWORD
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "to", eTo
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "toname", eToName
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "subject", eSubject
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "text", eBody
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "from", eFrom

    Dim filesToAttach As New Collection
    filesToAttach.Add "C:\temp\test.png"
    filesToAttach.Add "C:\temp\test2.jpg"

    AddMultipleFilesToStream outputStream, multiPartUploadBoundary, filesToAttach

    outputStream.WriteText "--" + multiPartUploadBoundary + "--" + vbCrLf

    Dim binaryStream As Object
    Set binaryStream = CreateObject("ADODB.Stream")
    binaryStream.Mode = 3 'read write
    binaryStream.Type = 1 'adTypeText 'Binary
    binaryStream.Open

    ' copy text to binary stream so xmlHttp.send works correctly
    outputStream.Position = 0
    outputStream.CopyTo binaryStream
    outputStream.Close

    binaryStream.Position = 0

    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "POST", HttpReqURL, False
    xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + multiPartUploadBoundary
    xmlHttp.setRequestHeader "Content-Length", Len(binaryStream.Size)
    xmlHttp.send binaryStream.Read(binaryStream.Size)

    binaryStream.Close
End Sub

Sub AddParameterAndValueToStream(stream As Variant, boundary As String, paramName As String, value As String)
    stream.WriteText "--" + boundary + vbCrLf
    stream.WriteText "Content-Disposition: form-data; name=""" + paramName + """" + vbCrLf
    stream.WriteText vbCrLf
    stream.WriteText value + vbCrLf
End Sub

Sub AddFileToStream(stream As Variant, boundary As String, name As String, filePath As String)
    Dim fileBytes As String
    fileBytes = ReadBinaryFile(filePath)

    stream.WriteText "--" + boundary + vbCrLf
    stream.WriteText "Content-Disposition: form-data; name=""files[" + name + "]""; filename=""" + name + """" + vbCrLf
    stream.WriteText "Content-Type: application/octet-stream" + vbCrLf
    stream.WriteText vbCrLf
    stream.WriteText fileBytes + vbCrLf
End Sub

Sub AddMultipleFilesToStream(stream As Variant, boundary As String, filePaths As Collection)
    Dim fileCount As Integer
    fileCount = filePaths.Count

    For n = 1 To fileCount
        Dim fileName As String
        Dim filePath As String

        filePath = filePaths(n)
        fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))

        AddFileToStream stream, boundary, fileName, filePath
    Next n
End Sub

Function ReadBinaryFile(strPath)
    Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
    Dim oFile: Set oFile = oFSO.GetFile(strPath)

    If IsNull(oFile) Then MsgBox ("File not found: " & strPath): Exit Function

    With oFile.OpenAsTextStream()
        ReadBinaryFile = .Read(oFile.Size)
        .Close
    End With
End Function

回答2:

Here it is!

Option Explicit

Sub SendEmailUsingSendGrid()
    Dim attachmentPath As String: attachmentPath = "C:\temp\test.png"
    Dim HttpReqURL As String: HttpReqURL = "https://api.sendgrid.com/api/mail.send.json"

    Const adSaveCreateNotExist = 1
    Const adSaveCreateOverWrite = 2
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeReadWrite = 3

    Dim YOUR_SG_CREDS_USERNAME As String
    YOUR_SG_CREDS_USERNAME = "username"

    Dim YOUR_SG_CREDS_PASSWORD As String
    YOUR_SG_CREDS_PASSWORD = "password"

    Dim multiPartUploadBoundary As String
    multiPartUploadBoundary = "123456789abc"

    Dim eTo As String
    eTo = "[e-mail]"

    Dim eToName As String
    eToName = "To Name"

    Dim eSubject As String
    eSubject = "My Subject"

    Dim eBody As String
    eBody = "This is a test!"

    Dim eFrom As String
    eFrom = "[e-mail]"

    Dim outputStream As Object
    Set outputStream = CreateObject("adodb.stream")
    outputStream.Type = adTypeText
    outputStream.Mode = adModeReadWrite
    outputStream.charset = "windows-1252"
    outputStream.Open

    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "api_user", YOUR_SG_CREDS_USERNAME
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "api_key", YOUR_SG_CREDS_PASSWORD
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "to", eTo
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "toname", eToName
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "subject", eSubject
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "text", eBody
    AddParameterAndValueToStream outputStream, multiPartUploadBoundary, "from", eFrom
    AddFileToStream outputStream, multiPartUploadBoundary, "test.png", "C:\temp\test.png"
    outputStream.WriteText "--" + multiPartUploadBoundary + "--" + vbCrLf

    Dim binaryStream As Object
    Set binaryStream = CreateObject("ADODB.Stream")
    binaryStream.Mode = 3 'read write
    binaryStream.Type = 1 'adTypeText 'Binary
    binaryStream.Open

    ' copy text to binary stream so xmlHttp.send works correctly
    outputStream.Position = 0
    outputStream.CopyTo binaryStream
    outputStream.Close

    binaryStream.Position = 0

    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "POST", HttpReqURL, False
    xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + multiPartUploadBoundary
    xmlHttp.setRequestHeader "Content-Length", Len(binaryStream.Size)
    xmlHttp.send binaryStream.Read(binaryStream.Size)

    binaryStream.Close
End Sub

Sub AddParameterAndValueToStream(stream As Variant, boundary As String, paramName As String, value As String)
    stream.WriteText "--" + boundary + vbCrLf
    stream.WriteText "Content-Disposition: form-data; name=""" + paramName + """" + vbCrLf
    stream.WriteText vbCrLf
    stream.WriteText value + vbCrLf
End Sub

Sub AddFileToStream(stream As Variant, boundary As String, name As String, filePath As String)
    Dim fileBytes As String
    fileBytes = ReadBinaryFile(filePath)

    stream.WriteText "--" + boundary + vbCrLf
    stream.WriteText "Content-Disposition: form-data; name=""files[" + name + "]""; filename=""" + name + """" + vbCrLf
    stream.WriteText "Content-Type: application/octet-stream" + vbCrLf
    stream.WriteText vbCrLf
    stream.WriteText fileBytes + vbCrLf
End Sub

Function ReadBinaryFile(strPath)
    Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
    Dim oFile: Set oFile = oFSO.GetFile(strPath)

    If IsNull(oFile) Then MsgBox ("File not found: " & strPath): Exit Function

    With oFile.OpenAsTextStream()
        ReadBinaryFile = .Read(oFile.Size)
        .Close
    End With
End Function

回答3:

Please see my "Here it is!" answer. I'm leaving this answer here for historical reasons only.

Try with something like this:

' Set the Server URL to the form input
HttpReqURL = "https://api.sendgrid.com/api/mail.send.json"

boundary = "----------------------------123456789abc"

Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
xmlhttp.Open "POST", HttpReqURL, False
xmlhttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + boundary 

dataToSend = "--" + boundary + vbCrLf
dataToSend = dataToSend + "Content-Disposition: form-data; name=""api_user""" + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + YOUR_API_USER + vbCrLf

dataToSend = dataToSend + "--" + boundary + vbCrLf    
dataToSend = dataToSend + "Content-Disposition: form-data; name=""api_key""" + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + YOUR_API_KEY + vbCrLf

dataToSend = dataToSend + "--" + boundary + vbCrLf            
dataToSend = dataToSend + "Content-Disposition: form-data; name=""to""" + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + eTo + vbCrLf

dataToSend = dataToSend + "--" + boundary + vbCrLf
dataToSend = dataToSend + "Content-Disposition: form-data; name=""toname""" + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + eToName + vbCrLf

dataToSend = dataToSend + "--" + boundary + vbCrLf
dataToSend = dataToSend + "Content-Disposition: form-data; name=""subject""" + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + eSubject + vbCrLf

dataToSend = dataToSend + "--" + boundary + vbCrLf
dataToSend = dataToSend + "Content-Disposition: form-data; name=""text""" + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + eBody + vbCrLf

dataToSend = dataToSend + "--" + boundary + vbCrLf
dataToSend = dataToSend + "Content-Disposition: form-data; name=""from""" + vbCrLf
dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + eFrom + vbCrLf

dataToSend = dataToSend + "--" + boundary + vbCrLf
dataToSend = dataToSend + "Content-Disposition: form-data; name=""files[1]""; filename=""myPDF.pdf""" + vbCrLf

dataToSend = dataToSend + vbCrLf
dataToSend = dataToSend + "Content-Type: application/octet-stream" + vbCrLf
dataToSend = dataToSend + vbCrLf

dataToSend = dataToSend + BASE64ENCODEDFILE + vbCrLf
dataToSend = dataToSend + "--" + boundary + "--" + vbCrLf

xmlhttp.send dataToSend