00181 20151103 웹에서 EPL 일정 가져오기 특정 사이트웹에 입력하기ex구글설문조사 - AngryQA/blog GitHub Wiki
웹에서 EPL 일정 가져오기 & 특정 사이트,웹에 입력하기(ex)구글설문조사
AngryQA | 2015-11-03 화요일 오후 12:27 | IT/VBA | 원본
웹에서 EPL 일정 가져오기 & 구글 설문지에 입력하기
하단은 소스
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
Dim HTMLDoc As HTMLDocument
Dim MyBrowser As InternetExplorer
Sub Sur()
'데이터 최신데이터로 모두 새로고침
ActiveWorkbook.RefreshAll
'Given
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
On Error GoTo Err_Clear
MyURL = "http://goo.gl/forms/cKnL8l3S1X"
Set MyBrowser = New InternetExplorer
tagetrow = 3
Dayda = "11"
'When
Do While Worksheets(1).Cells(tagetrow, 2).Value ""
If (Worksheets(1).Cells(tagetrow, 2) "경기가 없습니다.") Then
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = MyBrowser.document
Application.Wait (Now + TimeValue("0:00:01"))
'날짜
If (Worksheets(1).Cells(tagetrow, 1) "") Then
Dayda = Worksheets(1).Cells(tagetrow, 1)
End If
HTMLDoc.all.entry_715337389.Value = Dayda
Application.Wait (Now + TimeValue("0:00:01"))
'일정
HTMLDoc.all.entry_662637018.Value = Worksheets(1).Cells(tagetrow, 2)
Application.Wait (Now + TimeValue("0:00:01"))
'데이터 제출
For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input")
If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next
Application.Wait (Now + TimeValue("0:00:01"))
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
End If
tagetrow = tagetrow + 1
Loop
MyURL = "https://docs.google.com/spreadsheets/d/13FGvx-I_CzYJqdHWEGmWhH9qQUKnElJDYE_XU-JCcxI/edit?usp=sharing"
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Application.Wait (Now + TimeValue("0:00:07"))
Err_Clear:
If Err 0 Then
Err.Clear
Resume Next
End If
'브라우저 종료
MyBrowser.Quit
End Sub
| cs |