Question

这似乎是SendGrid Web API和电子邮件附件的常见问题。我在网上发现了很多很多帖子，所有这些帖子都有同样的问题......但似乎没有一个问题得到解答。 SendGrid自己的预设回复是使用他们的一个库...但问题仍然是当你使用没有库的语言时如何附加文件。

我已尝试在此问题上亲自联系SendGrid支持...甚至提供支持以获得答案，但他们认为我要求进行代码审核＆＃34;我不是。问题很简单：将附件上传到SendGrid Web API需要什么。

我之前曾经只是提供了建议的API格式中的文件位置，如下所示：Previous Example of Posting to SendGrid Using VBA这对我自己和其他几个人来说似乎工作了一段时间......但最近有些事情发生了变化。提供简单的文件路径似乎不再起作用。那么我现在需要做什么呢？我应该编码文件吗？如果是这样，我应该使用base64编码？我和其他许多人都会非常感谢这方面的任何帮助!!

这是我的base64尝试，但它与我以前的文件路径尝试存在相同的问题，即附件显示在电子邮件中......但无法打开。

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

Answer 1

这是！

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 = "to@example.com"

    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 = "from@example.com"

    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

Answer 2

此代码附加了一些额外的代码和逻辑来附加多个附件：

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 = "to@example.com"

    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 = "from@example.com"

    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

Answer 3

请看我的＆＃34;在这里！＆＃34;回答。我只是出于历史原因留下这个答案。

尝试这样的事情：

' 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

SendGrid附件使用API（VBA）为空或损坏

3 个答案:

SendGrid附件使用API​​（VBA）为空或损坏

3 个答案:

SendGrid附件使用API（VBA）为空或损坏