使用Excel VBA填写并提交Google文档表单

时间:2010-03-02 00:30:51

标签: vba excel-vba add-in online-forms excel

我正在尝试使用Excel this post,但使用Excel VBA。每次在Excel加载项上按下按钮时,我都想在google docs表单上提交回复。插件将是一个XLA文件,并用VBA编写。

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

--- ---编辑

This是我要写的形式(其中一个字段的代码摘录。)

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

- 编辑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

5 个答案:

答案 0 :(得分:2)

为了简化这一点,您需要将其分为两个步骤。

  1. 确切了解Google文档所需的POST。我会使用Firebug或类似工具来解决这个问题。我猜它是formkey,然后是一堆字段,如field1field2等。

  2. 现在使用MSXML2来发布数据(我不知道为什么它不会出现格式化为代码)。

    设置http = CreateObject(“MSXML2.ServerXMLHTTP”)

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

    http.Open“POST”,myURL,False

    http.setRequestHeader“User-Agent”,“Mozilla / 4.0(兼容; MSIE 6.0; Windows NT 5.0)”

    http.send(“”)''//不确定是否需要这个额外的SEND ..可能不是

    http.send( “formkey = Fd0SHgwQ3Yw&安培; field1的= A和FIELD2 = B”)

    MsgBox http.responseText

答案 1 :(得分:0)

Google Apps Script目前仅适用于拥有Google Apps帐户的人(通常是公司)。有很多要求:a)能够通过VBA访问这一点; b)允许非Apps用户访问 - 不幸的是,在过去的8个月内没有对这些请求进行重大更新。

答案 2 :(得分: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

答案 3 :(得分: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

答案 4 :(得分: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