问题描述
我正在尝试使用Sendgrid v3 API通过模板,个人数据和一个或多个附件发送邮件。现在已经花费了数天时间处理附件,似乎无法解决将PDF编码为JSON并包含PDF的全部内容的问题。测试时,我收到了邮件,并且有附件。但是只有400个字节,Adobe认为这是不可读的。在文本编辑器中打开它时,PDF包含文件名。 “所以,亲爱的,但不要雪茄……”
这是我的代码,减去API密钥:
<%
Session.LCID=1053
dagen = FormatDateTime(Now,2)
bilaga1 = "D:\\www5.volvobil.net\KC-Admin-sg\docs\bilaga13.pdf"
Function ReadFile(sfilepath)
Const adTypeText = 2
Const adTypeBinary = 1
Set B64Code = CreateObject("ADODB.Stream")
b64Code.Open
testCode = b64Code.LoadFromFile(sfilepath)
b64Code.Position = 0
b64Code.Type = adTypeText
b64Code.CharSet = "us-ascii"
dim bd
bd = b64Code.ReadText
B64Code.Close
ReadFile = Base64Encode(bd)
End Function
Function Base64Encode(sText)
Dim oXML,oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.dataType = "bin.base64"
oNode.nodeTypedValue = Stream_StringToBinary(sText)
Base64Encode = oNode.text
Set oNode = nothing
Set oXML = nothing
End Function
Function Base64Decode(ByVal vCode)
Dim oXML,oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.dataType = "bin.base64"
oNode.text = vCode
Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
Set oNode = nothing
Set oXML = nothing
End Function
Private Function Stream_StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeText
BinaryStream.CharSet = "us-ascii"
BinaryStream.Open
BinaryStream.WriteText Text
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
BinaryStream.Position = 0
Stream_StringToBinary = BinaryStream.Read
Set BinaryStream = nothing
End Function
Private Function Stream_BinaryToString(Binary)
Const adTypeText = 2
Const adTypeBinary = 1
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.Write Binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeText
BinaryStream.CharSet = "us-ascii"
Stream_BinaryToString = BinaryStream.ReadText
Set BinaryStream = nothing
End Function
toppbilden = "<img src=https://static.volvobil.se/images/mailutskick/600_header2_island.jpg alt=head border=0 />"
mailrubrik = "Byte av bil / Replacement of Car"
rubriken = "VÄLKOMMEN ATT BYTA DIN BIL"
enrubriken = "Welcome to replace your car (English version below)"
portalen = "<A HREF=https://intranet.volvocars.net/volvo-car-group/hr-portal/Pages/Company-cars-general-information-Sweden-Swedish.aspx>My Employment</A>"
portalenen = "<a href=https://intranet.volvocars.net/volvo-car-group/hr-portal/Pages/Company-cars-general-information-Sweden.aspx>My Employment</a>"
template = "d-3be42a9ce1db4461b2f72256fbb198eb"
filen = ReadFile(bilaga1)
filename = "bilaga13.pdf"
Response.Write "Filenamn = "& filename &" Fil = "& filen
data = "{""from"":{""email"":""norepy@volvobil.se""},""personalizations"":[{""to"":[{""email"":"""& epost &"""}],""dynamic_template_data"":{""receipt"":true,""name"":"""& namnet &""",""hallen"":"""& hallen &""",""regno"":"""& regno &""",""oldregno"":"""& oldregno &""",""bilen"":"""& bilen &""",""dagtiden"":"""& dagtiden &""",""levgubbe"":"""& levgubbe &"""}}],""attachments"": [{""content"": """& filen &""",""filename"":"""& filename &""",""type"":""application/pdf""}],""template_id"":"""& template &"""}"
link = "https://api.sendgrid.com/v3/mail/send"
Dim oXMLHTTP
Set oXMLHTTP = CreateObject("Msxml2.ServerXMLHTTP.6.0")
if oXMLHTTP is nothing then Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
oXMLHTTP.Open "POST",link,False
oXMLHTTP.setRequestHeader "Content-Type","application/json;charset=UTF-8"
oXMLHTTP.setRequestHeader "Authorization","Bearer <API-key>"
oXMLHTTP.send data
If oXMLHTTP.Status = 200 Then
PostData = oXMLHTTP.responseText
Else
response.Write "Status: " & oXMLHTTP.Status & " | "
response.Write oXMLHTTP.responseText
End If
SET oXMLHTTP = nothing
SET FormConad = nothing
Set objFSO = nothing
Set objFileOut = nothing
Set objXML = nothing
Set objDocElem = nothing
Set objStream = nothing
%>
输出是网页上的base64代码,状态:400 |来自Sendgrid的{“ errors”:[{“ message”:“ Bad Request”,“ field”:null,“ help”:null}]}。
附件没有问题,我已经尝试了一些。
非常感谢您的投入。
谢谢
哈斯
解决方法
看起来像是将文件内容作为文本而不是二进制流式传输。
总结;
-
bilaga1
变量不应包含D:\\
,因为这可能会导致LoadFromFile()
方法出错。有效的文件路径应该为D:\
。 - PDF不是文本文件,因此
ADODB.Stream
应该使用adTypeBinary
而不是adTypeText
。
作为旁注:
这是我为我不久前构建的SendGrid库编写的函数,应该使您对如何添加附件有所了解。
Sub AddMailAttachment(path,contenttype,disposition,filename,id)
Dim json: json = ""
Dim attachment,data
If Not IsEmpty(path) Then
If Left(path & "",4) = "http" Then
Dim xhr: Set xhr = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
With xhr
Call .Open("GET",path,False)
Call .Send()
If .Status = 200 Then
data = .ResponseBody
End If
End With
Else
Dim fso: Set fso = Server.CreateObject("Scripting.FileSystemObject")
Dim stream: Set stream = Server.CreateObject("ADODB.Stream")
If fso.FileExists(path) Then
With stream
Call .Open()
.Type = adTypeBinary
Call .LoadFromFile(path)
data = .Read()
End With
End If
End If
Dim contentid: contentid = Empty
Set attachment = New MailAttachment
If LCase(Trim(disposition & "")) = "inline" Then contentid = id
Call attachment.Create(data,contentid)
Call m_attachments.Add(attachment.Id,attachment)
End If
End Sub
该代码是类的一部分,因此无法从该示例访问某些元素,例如m_attachments
(这是存储该类附件的Scripting.Dictionary
)。这个想法是向您展示如何实现ADODB.Stream
。
这里是MailAttachment
类。
Class MailAttachment
Private m_id
Private m_contentid
Private m_content
Private m_contenttype
Private m_dispoition
Private m_filename
Private m_contentlength
Public Property Get Id
Id = m_Id
End Property
Public Property Get ContentId
ContentId = m_contentid
End Property
Public Property Get Content
Content = m_content
End Property
Public Property Get ContentType
ContentType = m_contenttype
End Property
Public Property Get Disposition
Disposition = m_dispoition
End Property
Public Property Get FileName
FileName = m_filename
End Property
Public Property Get Size
Size = m_contentlength
End Property
Private Sub Class_Initialize()
End Sub
Private Function ToBase64(rabyt)
Dim xml: Set xml = CreateObject("MSXML2.DOMDocument.3.0")
xml.LoadXml "<root />"
xml.documentElement.dataType = "bin.base64"
xml.documentElement.nodeTypedValue = rabyt
ToBase64 = Replace(xml.documentElement.Text,vbLf,"")
End Function
Public Sub Create(content,contentid)
m_id = CreateGuidPlainFormat()
m_contentid = contentid
m_contentlength = LenB(content)
m_content = ToBase64(content)
m_contenttype = contenttype
m_dispoition = disposition
m_filename = filename
End Sub
End Class
,
这实际上有效(Base64 Encode a ZIP file using Classic ASP and VB Script的技巧)和https://www.motobit.com/的功能。
但是,它要花很长时间,并且只能管理小文件,否则会超时。
这是当前代码:
Function Base64Encode(inData)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut,sOut,I
For I = 1 To Len(inData) Step 3
Dim nGroup,pOut,sGroup
nGroup = &H10000 * Asc(Mid(inData,I,1)) + _
&H100 * MyASC(Mid(inData,I + 1,1)) + MyASC(Mid(inData,I + 2,1))
nGroup = Oct(nGroup)
nGroup = String(8 - Len(nGroup),"0") & nGroup
pOut = Mid(Base64,CLng("&o" & Mid(nGroup,1,2)) + 1,1) + _
Mid(Base64,3,5,7,1)
sOut = sOut + pOut
Next
Select Case Len(inData) Mod 3
Case 1:
sOut = Left(sOut,Len(sOut) - 2) + "=="
Case 2:
sOut = Left(sOut,Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Function BinaryToString(Binary)
Dim I,S
For I = 1 To LenB(Binary)
S = S & Chr(AscB(MidB(Binary,1)))
Next
BinaryToString = S
End Function
Dim objStream,strFileText
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
objStream.LoadFromFile Server.MapPath(bilaga1)
strFileText = Base64Encode(BinaryToString(objStream.Read))
Response.Write strFileText
objStream.Close
Set objStream = Nothing