使用excel vba填写和提交google文档表单

为了使这件事简单化,你需要把它分成两步。

1. 弄清楚你需要谷歌文档的帖子是什么。我会用萤火虫或者类似的工具来解决这个问题。我猜大概是 formkey ,然后是一堆像 field1 , field2 等。

2. 现在使用msxml2来发布数据(我不知道为什么这不显示为代码格式)。

   设置http=createobject(“msxml2.serverxmlhttp”)

   MyURL= http://www.somedomain.com “

   打开“post”,myurl,false

   http.setrequestheader“用户代理”,“Mozilla/4.0(兼容;MSIE 6.0;Windows NT 5.0)”

   http.send(“”)//不确定是否需要此附加发送..大概不

   发送(“formkey=fd0shgwq3yw&field1=a&field2=b”)

   msgbox http.responsetext

Google Apps Script 目前只适用于那些拥有谷歌应用程序账户的用户(通常是公司)。有很多请求a)能够通过vba访问这个,b)允许非应用程序用户访问-不幸的是,在过去8个月内没有对这些请求的主要更新。

我能找到的最好的解决办法就是使用sendkeys。我知道这是不太理想的,但没有任何其他的反馈,在我有限的知识,这是最好的我可以想出。我已经接受了这个答案,由于赏金的要求,我不能撤消接受,但如果有更好的想法,在这里张贴,我会投票,并留下一个评论,说明这是答案。

Sub FillOutGoogleForm()
    Application.ScreenUpdating = False
    Dim IE As Object
    Dim uname       As String
    Dim ukey        As String

    uname = Environ("username")
    ukey = "00000-123kd-34kdkf-slkf"

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True

    While IE.busy
        DoEvents
    Wend

    IE.navigate "http://spreadsheets.google.com/viewform?hl=en&pli=1&formkey=dHFTMzkwR2RpY2tzSUNnbVhIcDN3WWc6MA"

    While IE.busy
        DoEvents
    Wend

    SendKeys uname
    While IE.busy
        DoEvents
    Wend
    SendKeys "{TAB}", True
    SendKeys ukey
    While IE.busy
        DoEvents
    Wend
    SendKeys "{TAB}", True
    SendKeys "{ENTER}", True
    SendKeys "%{F4}"
    Application.ScreenUpdating = True
End Sub

mark nold的回答通常是正确的,除了您应该使用winhttp而不是serverxmlhttp来避免必须设置代理等。

还要适当地设置内容类型头。这很可能是“application/x-www-form-urlencoded”(这里有更多内容: http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4 )

最后,必须在send()调用中使用发送数据。

form_data = "entry.0.single=some_username&entry.1.single=some_key&pageNumber=0&backupCache=&submit=Submit"
http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.Send form_data

转到表单编辑器

从响应中选择预填充的URL

请填写类似a1a2a3a4的字段名称,以便稍后查看答案

然后将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

我使用的全功能:

'http://stackoverflow.com/questions/2360153/use-excel-vba-to-fill-out-and-submit-google-docs-form/28079922#28079922

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