Anexos SendGrid estão vazios ou corrompidos usando a API (VBA)
Esse parece ser um problema constante da API da Web do SendGrid e dos anexos de email. Encontrei muitas postagens na Web, todas com o mesmo problema ... mas nenhuma parece ser respondida com uma solução. A resposta enlatada do SendGrid é usar uma de suas bibliotecas ... mas a questão permanece: como você anexa arquivos quando está usando um idioma que não possui uma biblioteca.
Eu tentei entrar em contato com o suporte do SendGrid nessa questão ... até me ofereci para pagar pelo suporte para obter uma resposta, mas eles pensaram que eu estava pedindo uma "revisão de código" que eu não estava. A questão é simplesmente a seguinte: O que é necessário para carregar anexos na API da Web SendGrid.
Eu costumava fornecer apenas o local do arquivo no formato API sugerido, como visto aqui:Exemplo anterior de postagem no SendGrid usando o VBA e isso pareceu funcionar bem por um tempo para mim e vários outros ... mas ultimamente algo mudou. Fornecer um caminho de arquivo simples não parece mais funcionar. Então, o que eu preciso fazer agora? Devo codificar o arquivo? Em caso afirmativo, qual codificação devo usar base64? Qualquer ajuda seria muito apreciada por mim e por muitos outros !!
Aqui está minha tentativa base64, mas ela está tendo o mesmo problema que as tentativas anteriores do caminho do arquivo, ou seja, o anexo é exibido no email ... mas não pode ser aberto.
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