Los archivos adjuntos de SendGrid están vacíos o corruptos con API (VBA)
Esto parece ser un problema constante con la API web SendGrid y los archivos adjuntos de correo electrónico. He encontrado muchas, muchas publicaciones en la web, todas las cuales tienen este mismo problema ... pero ninguna de ellas parece ser respondida con una solución. La propia respuesta enlatada de SendGrid es usar una de sus bibliotecas ... pero la pregunta sigue siendo cómo adjuntar archivos cuando está usando un idioma que no tiene una biblioteca.
Intenté contactarme con el soporte de SendGrid sobre este tema ... incluso me ofrecí a pagar por el soporte para obtener una respuesta, pero pensaron que estaba pidiendo una "revisión de código" que no era. La pregunta es simplemente esta: ¿Qué se necesita para cargar archivos adjuntos a la API web SendGrid?
Anteriormente solía proporcionar la ubicación del archivo dentro del formato de API sugerido como se ve aquí:Ejemplo anterior de publicación en SendGrid usando VBA y esto pareció funcionar bien por un tiempo para mí y varios otros ... pero últimamente algo ha cambiado. Proporcionar una ruta de archivo simple ya no parece funcionar. Entonces, ¿qué necesito hacer ahora? ¿Debo codificar el archivo? Si es así, ¿qué codificación debo usar base64? ¡Cualquier ayuda en esto sería muy apreciada por mí y por muchos otros!
Aquí está mi intento de base64 pero tiene el mismo problema que mis intentos anteriores de ruta de archivo, es decir, el archivo adjunto se muestra en el correo electrónico ... pero no se puede abrir.
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