5

我正在尝试使用 Excel VBA做类似这篇文章的事情。每次在 Excel 加载项上按下按钮时，我都想在 Google 文档表单上提交回复。插件将是一个 XLA 文件并用 VBA 编写。

我希望能够收集用户正在使用的功能。如果有人有更好的解决方案，我很开放。

- -编辑 - -

这是我要写入的表单（其中一个字段的代码摘录。）

<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-- 这是我迄今为止尝试过的，但它仍然无法正常工作。我在显示“.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
4

5 回答 5

2

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

  1. 准确计算出 Google Docs 所需的 POST。我会使用 Firebug 或类似的东西来解决这个问题。我猜它是这样的formkey，然后是一堆字段field1，field2等等。

  2. 现在使用 MSXML2 来发布数据（我不知道为什么这没有显示为代码格式）。

    设置 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 ("") ''// 不确定是否需要这个额外的 SEND.. 可能不需要

    http.send("formkey=Fd0SHgwQ3Yw&field1=A&field2=B")

    MsgBox http.responseText

于 2010-03-04T01:04:58.007 回答
0

Google Apps 脚本目前仅适用于拥有 Google Apps 帐户的人（通常是公司）。已经有很多请求 a) 能够通过 VBA 访问它和 b) 允许非应用程序用户访问 - 不幸的是，在过去 8 个月中这些请求没有重大更新。

于 2010-03-04T02:58:50.247 回答
0

我能找到的最佳解决方案是使用 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
于 2010-03-29T17:21:07.797 回答
0

Mark Nold 的回答通常是正确的，除了您应该使用 WinHTTP 而不是 ServerXMLHTTP 以避免处理必须设置代理等。

还要适当地设置 Content-Type 标头。这很可能是“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
于 2011-02-16T03:38:37.767 回答
0

转到表单编辑器

从回复中选择预填充的网址

填写字段名称，如 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

我使用的完整功能：

'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
于 2015-01-22T01:30:09.097 回答