Кажется, это постоянная проблема с веб-API SendGrid и приложениями электронной почты. Я нашел много, много постов в сети, у всех из которых есть та же самая проблема ... но ни на одно из них, кажется, не ответили решением. Собственный постоянный ответ SendGrid - использовать одну из их библиотек ... но остается вопрос: как прикреплять файлы, когда вы используете язык, у которого нет библиотеки.

Я пытался связаться со службой поддержки SendGrid по этому вопросу ... даже предлагал заплатить за поддержку, чтобы получить ответ, но они подумали, что я просил провести «проверку кода», которой я не был. Вопрос просто в следующем: что нужно для загрузки вложений в веб-API SendGrid.

Раньше я просто указывал расположение файла в предложенном формате API, как показано здесь:Предыдущий пример публикации в SendGrid с использованием 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