'конвертируем Кириллицу Public Function EncodeUriComponent(str) Static objHtmlfile As Object If objHtmlfile Is Nothing Then Set objHtmlfile = CreateObject("htmlfile") objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript" End If EncodeUriComponent = objHtmlfile.parentWindow.encode(str) End Function
[/vba]
[vba]
Код
'заворачиваем данные из диапазона rng в JSON Public Function ToArrJSON(rng As Range) As String ' Make sure there are two columns in the range If rng.Columns.Count < 2 Then ToArrJSON = CVErr(xlErrNA) Exit Function End If
Dim dataLoop, headerLoop As Long ' Get the first row of the range as a header range Dim headerRange As Range: Set headerRange = Range(rng.Rows(1).Address)
Dim colCount As Long: colCount = headerRange.Columns.Count
Dim json As String: json = "["
For dataLoop = 0 To rng.Rows.Count ' Include the first header row as well If dataLoop > 0 Then ' Start data row Dim rowJson As String: rowJson = "["
For headerLoop = 1 To colCount rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """" rowJson = rowJson & "," Next headerLoop
' Strip out the last comma rowJson = Left(rowJson, Len(rowJson) - 1)
' End data row json = json & rowJson & "]," End If Next
' Strip out the last comma json = Left(json, Len(json) - 1)
json = json & "]"
ToArrJSON = json End Function
[/vba]
Google Script часть:
[vba]
Код
function doPost(e) {
let ss = SpreadsheetApp.openById('************'); //id файла let sheet = ss.getSheetByName('*******');//имя листа
let content = e.parameter.content; let parsedContent = JSON.parse(content); let ResultArray = [parsedContent[0].slice()];
for (let i=1; i<parsedContent.length; i++) { ResultArray.push( parsedContent[i].slice() ) }
let needRows = ResultArray.length; let needCols = ResultArray[0].length;
Сохраняем. Делаем развёртывание. У меня всё работает. Присваиваем в VBA переменной webAppId нужный адрес Вэб-Приложения (после развёртывания копируем с экрана) .
В прикреплённом скрине все подключения, которые у меня есть в Tools => References =>
TvoiExcel, VBA часть: [vba]
Код
Sub sendPOST()
Const webAppId As String = "********" 'Id веб-приложения, доступного всем после авторизации
Dim httpRequest As Object 'MSXML2.XMLHTTP Dim URL As String Dim requestBody As Variant Dim row As Integer, col As Integer
Dim rng As Range Set rng = ActiveSheet.Range(Cells(1, 1), Cells(23, 14)) 'выбираем любой диапазон на активном листе
'конвертируем Кириллицу Public Function EncodeUriComponent(str) Static objHtmlfile As Object If objHtmlfile Is Nothing Then Set objHtmlfile = CreateObject("htmlfile") objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript" End If EncodeUriComponent = objHtmlfile.parentWindow.encode(str) End Function
[/vba]
[vba]
Код
'заворачиваем данные из диапазона rng в JSON Public Function ToArrJSON(rng As Range) As String ' Make sure there are two columns in the range If rng.Columns.Count < 2 Then ToArrJSON = CVErr(xlErrNA) Exit Function End If
Dim dataLoop, headerLoop As Long ' Get the first row of the range as a header range Dim headerRange As Range: Set headerRange = Range(rng.Rows(1).Address)
Dim colCount As Long: colCount = headerRange.Columns.Count
Dim json As String: json = "["
For dataLoop = 0 To rng.Rows.Count ' Include the first header row as well If dataLoop > 0 Then ' Start data row Dim rowJson As String: rowJson = "["
For headerLoop = 1 To colCount rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """" rowJson = rowJson & "," Next headerLoop
' Strip out the last comma rowJson = Left(rowJson, Len(rowJson) - 1)
' End data row json = json & rowJson & "]," End If Next
' Strip out the last comma json = Left(json, Len(json) - 1)
json = json & "]"
ToArrJSON = json End Function
[/vba]
Google Script часть:
[vba]
Код
function doPost(e) {
let ss = SpreadsheetApp.openById('************'); //id файла let sheet = ss.getSheetByName('*******');//имя листа
let content = e.parameter.content; let parsedContent = JSON.parse(content); let ResultArray = [parsedContent[0].slice()];
for (let i=1; i<parsedContent.length; i++) { ResultArray.push( parsedContent[i].slice() ) }
let needRows = ResultArray.length; let needCols = ResultArray[0].length;
Сохраняем. Делаем развёртывание. У меня всё работает. Присваиваем в VBA переменной webAppId нужный адрес Вэб-Приложения (после развёртывания копируем с экрана) .
В прикреплённом скрине все подключения, которые у меня есть в Tools => References =>airatgimranoff