Используйте Excel VBA для заполнения и отправки формы Документов Google. - PullRequest
5 голосов
/ 02 марта 2010

Я пытаюсь сделать что-то вроде этого поста , но с помощью Excel VBA.Я хотел бы отправлять ответ в форме документов Google при каждом нажатии кнопки в надстройке Excel.Надстройка будет XLA-файлом и написана на VBA.

Я хочу узнать, какие функции используют пользователи.Если у кого-то есть лучшее решение, я открыт.

--- Edit ---

Это - форма, в которую я пытаюсь написать (отрывок изкод для одного из полей.)

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

2 голосов
/ 04 марта 2010

Чтобы сделать это легко, вам нужно разбить его на два шага.

  1. Точно определите, какой POST вам нужен для Google Документов. Я бы использовал Firebug или подобное, чтобы решить это. Я предполагаю, что это что-то вроде formkey, тогда куча полей, таких как field1, field2 и т. Д.

  2. Теперь используйте MSXML2 для отправки данных (я не знаю, почему они не отображаются в формате кода).

    Set 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 ("") '' // Не уверен, что эта дополнительная отправка необходима .. вероятно, не

    http.send ( "formkey = Fd0SHgwQ3Yw & поле1 = А & поле2 = В") * * тысячу двадцать-пять

    MsgBox http.responseText

0 голосов
/ 22 января 2015

перейти в редактор форм

из ответов выберите предварительно заполненный URL

заполните имена полей, такие как 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

полная функция, которую я использовал:

'/1947361/ispolzuite-excel-vba-dlya-zapolneniya-i-otpravki-formy-dokumentov-google

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
0 голосов
/ 16 февраля 2011

Ответ Марка Нольда, как правило, правильный, за исключением того, что вместо ServerXMLHTTP следует использовать WinHTTP, чтобы избежать необходимости устанавливать прокси и т. Д.

Также установите заголовок 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
0 голосов
/ 29 марта 2010

Лучшее решение, которое я смог найти, это использовать 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
0 голосов
/ 04 марта 2010

Google Apps Script в настоящее время доступен только для тех, у кого есть аккаунты Google Apps (обычно компании). Было много запросов: а) получить доступ к нему через VBA и б) разрешить доступ пользователям, не являющимся приложениями, - к сожалению, за последние 8 месяцев не было серьезных обновлений этих запросов.

...