使用 Excel VBA 填写并提交 Google Docs 表单
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/2360153/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Use Excel VBA to fill out and submit Google Docs form
提问by guitarthrower
I'm trying to do something like this postbut with Excel VBA. I would like to submit a response on a google docs form each time a button is pressed on an Excel add-in. The addin will be an XLA file and written in VBA.
我正在尝试使用 Excel VBA执行类似这篇文章的操作。每次在 Excel 加载项上按下按钮时，我都想在 google 文档表单上提交回复。插件将是一个 XLA 文件并用 VBA 编写。
I want to be able to collect what features the users are using. If someone has a better solution, I'm open.
我希望能够收集用户正在使用的功能。如果有人有更好的解决方案，我很开放。
---Edit---
- -编辑 - -
Thisis the form I am trying to write to (excerpt of the code for one of the fields.)
这是我要写入的表单（其中一个字段的代码摘录。）
<div class="errorbox-good">
<div class="ss-item ss-item-required ss-text">
<div class="ss-form-entry">
<label for="entry_0" class="ss-q-title">
UserName
<span class="ss-required-asterisk">*</span>
</label>
<label for="entry_0" class="ss-q-help"></label>
<input type="text"
id="entry_0"
class="ss-q-short"
value=""
name="entry.0.single">
</div>
</div>
</div>
--EDIT 2-- This is what I've tried so far, but it is still not working. I am getting an error on the line that says ".UserName.Value = Environ("username")" I suspect it is because it is not finding the item .username.
--EDIT 2--这是我迄今为止尝试过的，但仍然无法正常工作。我在一行中收到一条错误消息：“.UserName.Value = Environ("username")” 我怀疑这是因为它没有找到 .username 项。
Private Sub GoogleForm()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
On Error GoTo errHandler
With ie
.navigate "http://spreadsheets.google.com/viewform?hl=en&cfg=true&formkey=dHFTMzkwR2RpY2tzSUNnbVhIcDN3WWc6MA"
Do While .busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop
With .document.Forms(1)
'Username
.UserName.Value = Environ("username")
'Key
.Key.Value = "00qwe-12ckd"
.submit
End With
Do While Not CBool(InStrB(1, .document.URL, _
"cp_search_response-e.asp"))
DoEvents
Loop
Do While .busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop
MsgBox .document.all.tags("table").Item(11).Rows(1).Cells(7).innerText
End With
Exit Sub
errHandler:
ie.Quit: Set ie = Nothing
End Sub
采纳答案by guitarthrower
The best solution I could find was to use sendkeys. I know it is less than ideal, but without any other feedback here, and with my limited knowledge it is best I could come up with. I have accepted this answer, and because of the bounty request I can't undo the acceptance, but if there is a better idea post here and and I will upvote and leave a comment stating it is the answer.
我能找到的最佳解决方案是使用 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
回答by Mark Nold
To make this easy you need to break it into two steps.
为了使这变得容易，您需要将其分解为两个步骤。
Work out exactly what the POST you need for Google Docs. I'd use Firebug or similar to work this out. I'm guessing it's something like
formkey, then a bunch of fields likefield1,field2etc.Now use MSXML2 to POST the data (Ive no idea why this isnt appearing formatted as code).
Set http= CreateObject("MSXML2.ServerXMLHTTP")
myURL= "http://www.somedomain.com"
http.Open "POST", myURL, False
http.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
http.send ("") ''// Not sure this additional SEND is needed.. probably not
http.send("formkey=Fd0SHgwQ3Yw&field1=A&field2=B")
MsgBox http.responseText
准确计算出 Google Docs 所需的 POST。我会使用 Firebug 或类似工具来解决这个问题。我猜它是这样的
formkey，然后是一堆字段，例如field1，field2等等。现在使用 MSXML2 POST 数据（我不知道为什么这不显示为代码格式）。
设置 http= CreateObject("MSXML2.ServerXMLHTTP")
myURL=" http://www.somedomain.com"
http.Open "POST", myURL, False
http.setRequestHeader“用户代理”、“Mozilla/4.0（兼容；MSIE 6.0；Windows NT 5.0）”
http.send ("") ''// 不确定是否需要额外的 SEND.. 可能不需要
http.send("formkey=Fd0SHgwQ3Yw&field1=A&field2=B")
MsgBox http.responseText
回答by Todd Main
Google Apps Scriptis currently only available for those who have Google Apps accounts (usually companies). There have been plenty of requests to a) be able to access this via VBA and b) allow non-Apps users to have access - no major updates to these requests in the last 8 months unfortunately.
Google Apps Script目前仅适用于拥有 Google Apps 帐户的人（通常是公司）。有很多请求 a) 能够通过 VBA 访问它和 b) 允许非应用程序用户访问 - 不幸的是，在过去 8 个月中这些请求没有重大更新。
回答by Victor Olex
Mark Nold's answer is generally correct except you should rather use WinHTTP instead of ServerXMLHTTP to avoid dealing with having to set proxies etc.
Mark Nold 的回答通常是正确的，除非您应该使用 WinHTTP 而不是 ServerXMLHTTP 以避免处理必须设置代理等。
Also set the Content-Type header appropriately. This should most likely be "application/x-www-form-urlencoded" (more on that here: http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4)
还要适当地设置 Content-Type 标头。这很可能是“application/x-www-form-urlencoded”（更多关于这里的信息：http: //www.w3.org/TR/html401/interact/forms.html#h-17.13.4）
Finally you must send the data with in the Send() call.
最后，您必须在 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
回答by Shimon Doodkin
go to form editor
转到表单编辑器
from responses choose prefilled url
从响应中选择预填充的 url
fill in field names like a1 a2 a3 a4 for the answers so you will see it later
填写字段名称，如 a1 a2 a3 a4 作为答案，以便您稍后看到
then change the in the url from viewform to formResponse like:
然后将 url 从 viewform 更改为 formResponse ，如：
https://docs.google.com/forms/d/123-ycyAMD4/viewform?entry.1237336855=a1..
to
到
https://docs.google.com/forms/d/123-ycyAMD4/formResponse?entry.1237336855=a1...
then http get this url in some way like:
然后 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
full function i used:
我使用的完整功能：
'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
