перейти в редактор форм
из ответов выберите предварительно заполненный URL
заполните имена полей, такие как a1 a2 a3 a4 для ответов, чтобы вы увидели это позже
затем измените URL-адрес с viewform на formResponse, например:
https://docs.google.com/forms/d/123-ycyAMD4/viewform?entry.1237336855=a1..
до
https://docs.google.com/forms/d/123-ycyAMD4/formResponse?entry.1237336855=a1...
тогда http получит этот URL как-то так:
Sub sendresult()
dim a1,a2,a3
a1="ans1"
a2="ans2"
a3="ans3"
dim myURL
myURL= "https://docs.google.com/forms/d/123-ycyAMD4/formResponse?" & _
"entry.1237336855=" & a1 & _
"&entry.2099352330=" & a2 & _
"&entry.962062701=" & a3
dim http
Set http= CreateObject("MSXML2.ServerXMLHTTP")
http.Open "GET", myURL, False
http.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
http.send
MsgBox http.responseText
end sub
полная функция, которую я использовал:
'/1947361/ispolzuite-excel-vba-dlya-zapolneniya-i-otpravki-formy-dokumentov-google
Dim savedname
Sub sendresult()
Dim ScriptEngine
Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
ScriptEngine.Language = "JScript"
ScriptEngine.AddCode "function encode(str) {return encodeURIComponent(str);}"
Dim name, points, times, t1, t2, t3, t4
times = Sheet5.Range("C13").Value
If times = "0" Or times = "" Then
MsgBox "no data"
Exit Sub
End If
If savedname = Empty Then savedname = InputBox("enter your name")
name = ScriptEngine.Run("encode", savedname)
points = Sheet5.Range("C12").Value
t1 = Sheet5.Range("C7").Value
t2 = Sheet5.Range("C8").Value
t3 = Sheet5.Range("C9").Value
t4 = Sheet5.Range("C10").Value
Dim myURL
myURL = "https://docs.google.com/forms/d/123-ycyAMD4/formResponse?" & _
"entry.1237336855=" & name & _
"&entry.2099352330=" & points & _
"&entry.962062701=" & times & _
"&entry.1420067848=" & t1 & _
"&entry.6696464=" & t2 & _
"&entry.1896090524=" & t3 & _
"&entry.1172632640=" & t4
Dim http
Set http = CreateObject("MSXML2.ServerXMLHTTP")
http.Open "GET", myURL, False
http.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
http.send
Dim resp
If UBound(Split(http.responseText, "<div class=""ss-resp-message"">")) > 0 Then
resp = Split(Split(http.responseText, "<div class=""ss-resp-message"">")(1), "</div>")(0)
Else
resp = "sent(with unexpected server response)"
End If
If resp = "Your response has been recorded." Then resp = "input received"
MsgBox resp
End Sub