I made a vba script to ‘automaticaly’ export the answers of a survey to an Excel sheet. I made it thanks to the help of vkuzmin on this forum (
This is the code I made (I am no developer, I just mixed sources I found online):
Code:
' -----------------------------------------------------------------------
' 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
I hope it will help people.
Topic Author
