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 开发者_C百科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
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
,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
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.
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
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
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..
to
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
精彩评论