使用 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

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 11:22:59  来源:igfitidea点击:

Use Excel VBA to fill out and submit Google Docs form

vbaexcel-vbaadd-inonline-formsexcel

提问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.

为了使这变得容易,您需要将其分解为两个步骤。

  1. 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 like field1, field2etc.

  2. 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

  1. 准确计算出 Google Docs 所需的 POST。我会使用 Firebug 或类似工具来解决这个问题。我猜它是这样的formkey,然后是一堆字段,例如field1field2等等。

  2. 现在使用 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