אופיס 365 שליחת מייל באקסס דרך SENDGREAD

[סימה שלי]

שלום רב!

יש לי קוד באקסס שאני שולחת דרכו מיילים דרך SENDGREAD .
אבל יש לי בעיה לשלוח בעברית, הוא לא קולט ומחזיר שגיאה 400 (השליחה מתבצעת דרך XML) והמייל לא נשלח.
באנגלית השליחה מתבצעת מצוין, כשאני מנסה לשרשר קוד של BYTE (לאחר שביצעתי המרה של UTF8) בתוך השירשור הוא כותב שגיאה.
אם אני ממירה את הBYTE לSTRING הוא רושם לי ?????

אשמח לעזרה

Option Compare Database

Public Function sendgread()
Dim reportName As String
Dim path As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Dim strAttachments As String
Dim strTransPort 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 sReq As String
Dim ePass As String
Dim eUser As String
Dim strXML As String
Dim fePath As String
Dim FileName As String
Dim eBodyFrom As String

eTo = "<לא ניתן לפרסם מיילים באופן פומבי>"
eFrom = "<לא ניתן לפרסם מיילים באופן פומבי>"
eBody = "Send Emails Via The SendGrid API Directly From Access!"
eSubject = "Easy Way To Email From Access"
eToName = "Anthony Griggs"
eUser = "Your_SendGrid_UserName"
ePass = "Your_SendGrid_Password"

' Concatenate file locations of attachments in the following format:
' &files[File_Name.pdf]=File_Path    *** File Path Including File Name ***
strAttachments = "&files[rptOverdueTrainingByEmployee.pdf]=C:\Users\sixHat.HAZDATA\Desktop\IDMS\TempOutput\rptOverdueTrainingByEmployee.pdf&files[rptTrainingSummaryByEmployee.pdf]=C:\Users\sixHat.HAZDATA\Desktop\IDMS\TempOutput\rptTrainingSummaryByEmployee.pdf&files[rptOverallSummary.pdf]=C:\Users\sixHat.HAZDATA\Desktop\IDMS\TempOutput\rptOverallSummary.pdf"

' Call The SendGrid API
sReq = "https://api.sendgrid.com/api/mail.send.xml?" _
& "api_user=" & eUser _
& "&api_key=" & ePass _
& "&to=" & eTo _
& "&toname=" & eToName _
& "&subject=" & eSubject _
& "&text=" & eBody _
& "&from=" & eFrom _
& strAttachments
' files[file1.jpg]=file1.jpg&files[file2.pdf]=file2.pdf
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")

xmlhttp.Open "POST", sReq, False
xmlhttp.send
[LEFT] byteData = xmlhttp.responseBody
[/LEFT]
 
Set xmlhttp = Nothing

strXML = StrConv(byteData, vbUnicode)

End Function

הוספתי את הUTF8

Option Compare Database

Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long) As Long
    
' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001

''' Return byte array with VBA "Unicode" string encoded in UTF-8
Public Function Utf8BytesFromString(strInput As String) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, vbNull, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    Utf8BytesFromString = abBuffer
End Function

באנגלית הוא שולח מצוין.
כשאני משנה את השורה הזו

eSubject = "Easy Way To Email From Access"

למילה שלום

eSubject = "שלום"

הוא עושה בעיות..
בתודה מראש.
​

 

[סימה שלי]

הסתדרתי.
כעת נשאר לי בעיה שאני צריכה לשלוח מאקסס קובץ PDF דרך URL
הקובץ נראה שנשלח, אך בפועל הוא שולח קובץ דמה (בלי הנתונים של הקובץ המקורי).
בעת הורדת הקובץ הוא כותב שהקובץ לא קודד כראוי.
משהו יודע איך עושים את זה??

בתודה.

 

[יאיר משה]

אולי תשתפי אותנו איך הסתדרת?

 

[סימה שלי]

הבעיה היתה שאני שולחת את הנתונים ב URL ושם הייתי צריכה להמיר אותו לBYTE ולהוסיף בין כל BYTE %
להלן הקוד שעשה את העבודה...
ב VBA כמובן...

Private Const CP_UTF8 = 65001
Private Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, ByVal dwflags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Public Function UTF16To8(ByVal UTF16 As String) As String
Dim sBuffer As String
Dim lLength As Long
If UTF16 <> "" Then
    lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, 0, 0, 0, 0)
    sBuffer = Space$(lLength)
    lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
    sBuffer = StrConv(sBuffer, vbUnicode)
    UTF16To8 = Left$(sBuffer, lLength - 1)
Else
    UTF16To8 = ""
End If
End Function

Public Function URLEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False, _
   Optional UTF8Encode As Boolean = True _
) As String

Dim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(StringVal), StringVal)
Dim StringLen As Long: StringLen = Len(StringValCopy)

If StringLen > 0 Then
    ReDim Result(StringLen) As String
    Dim I As Long, CharCode As Integer
    Dim Char As String, Space As String

  If SpaceAsPlus Then Space = "+" Else Space = "%20"

  For I = 1 To StringLen
    Char = Mid$(StringValCopy, I, 1)
    CharCode = Asc(Char)
    Select Case CharCode
      Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
        Result(I) = Char
      Case 32
        Result(I) = Space
      Case 0 To 15
        Result(I) = "%0" & Hex(CharCode)
      Case Else
        Result(I) = "%" & Hex(CharCode)
    End Select
  Next I
  URLEncode = Join(Result, "")

End If
End Function

וזה המחרוזת ששלחתי לפונקציה.
​

URLEncode("שלום")

אשמח אם משהו יוכל לעזור לי עם העלאת הקובץ... איך מבצעים המרה לקובץ PDF לBYTE????
​

 

[יאיר משה]

סליחה על הבורות, איפה מזינים את מייל הנמען?

 

[shsh654]

סליחה על הבורות, איפה מזינים את מייל הנמען?

כנראה שבשורה הזו

eTo = "<לא ניתן לפרסם מיילים באופן פומבי>"