Use Excel VBA to fill out and submit Google Docs form

问题

I'm trying to do something like this post but 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.

I want to be able to collect what features the users are using. If someone has a better solution, I'm open.

---Edit---

This is 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.

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

回答1:

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 like field1, field2 etc.
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

回答2:

Google Apps Script is 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.

回答3:

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.

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

回答4:

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.

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)

Finally you must send the data with in the Send() call.

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

回答5:

go to form editor

from responses choose prefilled url

fill in field names like a1 a2 a3 a4 for the answers so you will see it later

then change the in the url from viewform to formResponse like:

https://docs.google.com/forms/d/123-ycyAMD4/viewform?entry.1237336855=a1..

https://docs.google.com/forms/d/123-ycyAMD4/formResponse?entry.1237336855=a1...

then http get this url in some way like:

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

来源：https://stackoverflow.com/questions/2360153/use-excel-vba-to-fill-out-and-submit-google-docs-form

标签

vba

excel-vba

add-in

online-forms

excel