- Posts: 4
- Thank you received: 3
Ask the community, share ideas, and connect with other LimeSurvey users!
' ----------------------------------------------------------------------- ' JSON RPC CONNECTIVITY SETTINGS ' ----------------------------------------------------------------------- ' This file will contain the settings needed to access json RPC with vba. ' ' This VBA code use two different modules: ' VBA JSON tools: https://github.com/VBA-tools/VBA-JSON ' Base64 Deconding: https://www.vbforums.com/showthread.php?379072-VB-Fast-Base64-Encoding-and-Decoding&p=2539878&viewfull=1#post2539878 ' ' I used the script made by vkuzmin as a base: ' https://www.limesurvey.org/community/forums/can-i-do-this-with-limesurvey/114846-export-answers-to-excel-in-semi-realtime ' Sub export_limesurvey() Dim key As String Dim limeuser As String, limepass As String, limeurl As String, URL As String Dim jsonText As String, jsonObject As Object Dim SurveyID As String, DocumentType As String Dim export64 As String, export64Decoded As String limeurl = "https://www.website.com/index.php" limeuser = "user" limepass = "pasword" SurveyID = "id" DocumentType = "csv" 'Clear page Cells.Clear 'Initalization Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") URL = limeurl + "/admin/remotecontrol" objHTTP.Open "POST", URL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.setRequestHeader "Content-type", "application/json" 'Get key sendtext = "{""method"":""get_session_key"",""params"": [""" + limeuser + """,""" + limepass + """],""id"": 1}" objHTTP.Send (sendtext) jsonText = objHTTP.responseText Set jsonObject = JsonConverter.ParseJson(jsonText) key = jsonObject("result") 'Export answers sendtext = "{""method"":""export_responses"",""params"": [""" + key + """,""" + SurveyID + """,""" + DocumentType + """],""id"": 1}" objHTTP.Send (sendtext) jsonText = objHTTP.responseText Set jsonObject = JsonConverter.ParseJson(jsonText) export64 = jsonObject("result") 'Decode answers export64Decoded = Decode64(export64) 'Close session sendtext = "{""method"":""release_session_key"",""params"": [""" + key + """],""id"": 1}" objHTTP.Send (sendtext) 'Divide the respond in multiple lines, otherwise evrything is in one cell s = export64Decoded i = 0 While Split(s, Chr(13) + Chr(10))(i) <> "" Cells(i + 1, 1) = Split(s, Chr(13) + Chr(10))(i) i = i + 1 Wend 'Convert CSV Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=True, Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True Cells.WrapText = False End Sub
limeurl = "https://12.345.678.901/index.php" limeuser = "user" limepass = "XXXXXXXXXX" SurveyID = "123456" DocumentType = "csv"