Sử dụng Excel VBA để điền và gửi biểu mẫu Google Tài liệu

Question

Tôi đang cố gắng thực hiện một cái gì đó như this post nhưng với Excel VBA. Tôi muốn gửi câu trả lời trên biểu mẫu tài liệu google mỗi lần nhấn nút trên bổ trợ Excel. Addin sẽ là một tệp XLA và được viết bằng VBA.

Tôi muốn có thể thu thập những tính năng mà người dùng đang sử dụng. Nếu ai đó có giải pháp tốt hơn, tôi sẽ mở.

--- Chỉnh sửa ---

This là hình thức Tôi cố gắng để viết thư cho (trích đoạn của mã cho một trong những lĩnh vực này.)

<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-- Đây là những gì tôi đã cố gắng cho đến nay, nhưng nó vẫn không hoạt động. Tôi nhận được một lỗi trên dòng mà nói ".UserName.Value = Environ (" tên người dùng ")" Tôi nghi ngờ nó là bởi vì nó không phải là tìm mục .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 

Answer 1

Giải pháp tốt nhất tôi có thể tìm thấy là sử dụng các phím tắt. Tôi biết nó ít hơn lý tưởng, nhưng không có bất kỳ phản hồi nào khác ở đây, và với kiến ​​thức hạn chế của tôi, tốt nhất là tôi có thể nghĩ ra. Tôi đã chấp nhận câu trả lời này, và vì yêu cầu tiền thưởng, tôi không thể hoàn tác việc chấp nhận, nhưng nếu có một ý tưởng tốt hơn đăng bài ở đây và tôi sẽ upvote và để lại một bình luận nói đó là câu trả lời.câu trả lời

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 

Answer 2

Để dễ dàng, bạn cần chia thành hai bước.

1. Tìm hiểu chính xác POST bạn cần cho Google Documents. Tôi muốn sử dụng Firebug hoặc tương tự để làm việc này. Tôi đoán nó là cái gì như formkey, sau đó một loạt các lĩnh vực như field1, field2, vv

2. Bây giờ sử dụng MSXML2 POST dữ liệu (Ive không biết lý do tại sao isnt này xuất hiện định dạng như code).

   Set http = CreateObject ("MSXML2.ServerXMLHTTP")

   myURL =

   http.Open "POST" "http://www.somedomain.com", myURL, False

   http.setRequestHeader "User-Agent" "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"

   http.send ("") '' // không chắc SEND bổ sung này là cần thiết .. có lẽ không

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

   MsgBox http.responseText

Answer 3

Google Apps Script hiện chỉ có sẵn cho những người có tài khoản Google Apps (thường là các công ty) . Đã có rất nhiều yêu cầu cho a) có thể truy cập thông qua VBA và b) cho phép người dùng không sử dụng có quyền truy cập - không có cập nhật lớn nào cho các yêu cầu này trong 8 tháng qua.

Answer 4

Đánh dấu Nold nói chung là đúng ngoại trừ bạn chứ không nên sử dụng WinHTTP thay vì ServerXMLHTTP để tránh đối phó với việc phải thiết lập proxy, vv

Cũng đặt tiêu đề Content-Type thích hợp. Điều này rất có thể là "ứng dụng/x-www-form-urlencoded" (nhiều hơn ở đây: http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4)

Cuối cùng, bạn phải gửi dữ liệu trong cuộc gọi 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 

Answer 5

đi để tạo thành biên tập

từ phản ứng chọn url đóng sẵn

điền vào tên trường như a1 a2 a3 a4 cho câu trả lời, do đó bạn sẽ thấy nó sau này

sau đó thay đổi trong url từ dạng xem tới formResponse như:

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

sau đó http get url này trong một số cách như:

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 

chức năng đầy đủ i sử dụng:

'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