Snasui Excel Forum

Code: Select all

Sub LineNotifyUploadPic(msg As String, Optional UploadFilePath As String = "none")
Dim sFilepath As String
Dim nFile As Integer
Dim baBuffer() As Byte
Dim ssPostData1 As String Dim ssPostData2 As String Dim ssPostData3 As String Dim Messagelength As Integer Dim objectXML As Object
Dim arr1() As Byte Dim arr2() As Byte Dim arr3() As Byte Dim arr4() As Byte
Const STR_BOUNDARY As String = "xxx---thepexcel---thepexcel---thepexcel---xxx" '??? Token ??????
LineToken = "I2UXLTEOlMmiHPkTu7VFHmrORRUFt9COHLPKL4ZPYSy"
sFilepath = UploadFilePath
sFileName = GetFilenameFromPath(sFilepath)
ssPostData1 = vbCrLf & _
"--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=" & """message""" & vbCrLf & vbCrLf & vbCrLf & Range("K1").Value
arr1 = StrConv(ssPostData1, vbFromUnicode) arr2 = (msg)
ssPostData2 = vbCrLf & _
"--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=" & """imageFile""" & "; filename=" & sFileName & vbCrLf & _
"Content-Type: image/jpng" & vbCrLf & vbCrLf
arr3 = StrConv(ssPostData2, vbFromUnicode)
nFile = FreeFile
Open sFilepath For Binary Access Read As nFile If LOF(nFile) > 0 Then
ReDim baBuffer(0 To LOF(nFile) - 1) As Byte Get nFile, , baBuffer
imagear = baBuffer
End If
Close nFile

 arr4 = StrConv(vbCrLf & "--" & STR_BOUNDARY & "--" & vbCrLf, vbFromUnicode)
Dim arraytotal As Long
Dim sendarray() As Byte
arraytotal = UBound(arr1) + UBound(arr2) + UBound(arr3) + UBound(imagear) + UBound(arr4) + 4
ReDim sendarray(arraytotal)
For i = 0 To UBound(arr1) sendarray(i) = arr1(i) Next
For i = 0 To UBound(arr2) sendarray(UBound(arr1) + i + 1) = arr2(i) Next
For i = 0 To UBound(arr3)
sendarray(UBound(arr1) + UBound(arr2) + i + 2) = arr3(i) Next
For i = 0 To UBound(imagear)
sendarray(UBound(arr1) + UBound(arr2) + UBound(arr3) + i + 3) = imagear(i) Next
For i = 0 To UBound(arr4)
sendarray(UBound(arr1) + UBound(arr2) + UBound(arr3) + UBound(imagear) + i + 4) = arr4(i)
Next
Set objectXML = CreateObject("Microsoft.XMLHTTP") URL = "https://notify-api.line.me/api/notify"
With objectXML
.Open "POST", URL, 0
.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
.SetRequestHeader "Authorization", "Bearer " & LineToken .send sndar(sendarray)
Debug.Print .responseText
End With
Set objectXML = Nothing
End Sub
Public Function sndar(sendarray As Variant) As Byte()
sndar = sendarray
End Function
Public Function GetFilenameFromPath(ByVal strPath As String) As String If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then

 GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function

Code: Select all

Sub Test0()
    Dim winReq As Object, iMsg As String
    Dim tk As String, postdata As String
    
    Set winReq = CreateObject("Microsoft.XMLHTTP")
    tk = "I2UXLTEOlMmiHPkTu7VFHmrORRUFt9COHLPKL4ZPYSy"
    myURL = "https://notify-api.line.me/api/notify"
    postdata = "message=" & "สวัสดี"
    With winReq
        .Open "POST", myURL, False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .SetRequestHeader "Authorization", "Bearer " & tk
        .send ("message=" & postdata)
    End With
End Sub

Code: Select all

ssPostData1 = vbCrLf & _
"--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=" & """message""" & vbCrLf & vbCrLf & vbCrLf & Range("K1").Value
arr1 = StrConv(ssPostData1, vbFromUnicode)