kasl

不好意思 我可能需要版主您提點我一下
圖片中 那個日期有一個是下拉 其它二個是用填值的 我不知這種的怎麼寫
我會寫一個後 就會改成用迴圈來抓取我需要的值了

GBKEE

回復 11# kasl
試試看

1. Option Explicit
   
2. Const Code_txt = "D:\Code.Txt"
   
3. Const FormDLL = "FM20.DLL"
   
4. Sub Ex_Ie_下一頁()
   
5.     Dim IE As Object, URL As String, E As Variant, i As Integer
   
6.     Dim StartDate As Date, EndDate As Date
   
7.     Dim A As Variant, Table As Object, Ar_Code(), Code As Variant
   
8.     Set_FormDLL
   
9.     StartDate = DateAdd("yyyy", -1, Date) '1年前的日期
   
10.     'StartDate = DateAdd("m", -1, Date)    '1個月前的日期
    
11.     EndDate = Date
    
12.     MsgBox EndDate & " -- " & StartDate
    
13.     Ar_Code = Array("sgen", "AMEH", "HMNC")  'Code 的陣列
    
14.     'Ar_Ccod() = Array("sgen", "AMEH", "HMNC", "OZM", "ARCC", "TDG", "ECL", "AN")
    
15.     Set IE = CreateObject("InternetExplorer.Application")
    
16.     With IE
    
17.         For Each Code In Ar_Code
    
18.             If Dir(Code_txt) <> "" Then Kill Code_txt
    
19.             URL = "http://www.cnyes.com/USAstock/history.aspx?code=" & Code
    
20.          '   .Visible = True     '  是否顯示 IE
    
21.             .Navigate URL
    
22.             Application.StatusBar = Code & " 網頁 開啟中..."
    
23.             Do While .Busy Or .readyState <> 4:  DoEvents:       Loop
    
24.             If .LocationURL = "http://www.cnyes.com/usastock/index.htm" Then
    
25.                 MsgBox "Code 找不到 " & Code
    
26.                 GoTo Code_Next
    
27.             End If
    
28.             Application.StatusBar = Code & "日期 " & EndDate & " -- " & StartDate & " 指定中..."
    
29. 
    
30.             With .document.getElementsByTagName("SELECT")           '月份輸入
    
31.                 .Item("startMonth").Value = Month(StartDate) - 1    '開始月份
    
32.                 .Item("endMonth").Value = Month(EndDate) - 1        '結束月份
    
33.             End With
    
34.             With .document.getElementsByTagName("INPUT")
    
35.                 .Item("startDay").Value = Day(StartDate)            '開始日期
    
36.                 .Item("startDay").Value = Day(StartDate)            '開始日期
    
37.                 .Item("startYear").Value = Year(StartDate)          '開始年度
    
38.                 .Item("endDay").Value = Day(EndDate)                '結束日期
    
39.                 .Item("endYear").Value = Year(EndDate)              '結束年度
    
40.                 .Item("perPage").Value = 100                        '顯示資料的筆數
    
41.             End With
    
42.             For Each E In .document.getElementsByTagName("BUTTON")
    
43.                 If E.Type = "submit" Then
    
44.                     E.Click                                         '按下搜尋鍵
    
45.                     Exit For
    
46.                 End If
    
47.             Next
    
48.             Application.StatusBar = "按下搜尋鍵 等候網頁中... "
    
49.             Do While .Busy Or .readyState <> 4:   DoEvents:       Loop
    
50.             Application.Wait Time + #12:00:10 AM#                   '等候網頁
    
51.             Set Table = .document.getElementsByTagName("TABLE")
    
52.             For Each E In .document.getElementsByTagName("SPAN")
    
53.                 If InStr(E.innerText, "Page   of") Then
    
54.                     i = Val(Replace(E.innerText, "Page   of", ""))   '取得資料總頁數
    
55.                     Exit For
    
56.                 End If
    
57.             Next
    
58.             On Error GoTo Ie_Err
    
59.             For A = 0 To i
    
60.                 Application.StatusBar = Code & "  " & EndDate & " -- " & StartDate & "共 " & i & " 頁 下載  第 " & A + IIf(A = 0, 1, 0) & " 中..."
    
61.                 For Each E In .document.getElementsByTagName("A")
    
62.                     If Trim(E.innerText) = ">" Then
    
63.                         If A > 1 Then E.Click                          '下一頁按鍵
    
64.                             Do While .Busy Or .readyState <> 4:   DoEvents:       Loop
    
65.                             Application.Wait Time + #12:00:05 AM#                '等候網頁
    
66.                             Set Table = .document.getElementsByTagName("TABLE")
    
67.                             Exit For
    
68.                         End If
    
69.                 Next
    
70.                 If A = 0 Or A > 1 Then
    
71.                 Close #1
    
72.                 Open Code_txt For Append As #1
    
73.                 Print #1, Table(12).outerHTML
    
74.                 Close #1
    
75.                 End If
    
76.             Next
    
77.             Date_of_refresh Code, A  '導入資料程式 要給參數 Code , A
    
78. Code_Next:
    
79.         Next
    
80.         .Quit
    
81.     End With
    
82.     Application.StatusBar = False
    
83.     Remove_FormDLL
    
84.     MsgBox "Ok"
    
85.     Exit Sub
    
86. Ie_Err:
    
87.     Application.Wait Time + #12:00:05 AM#                '等候網頁
    
88.     Set Table = IE.document.getElementsByTagName("TABLE")
    
89.     Resume
    
90. End Sub
    
91. Private Sub Date_of_refresh(ByVal Code As String, ByVal xPage As Integer) '導入資料程式
    
92.     Dim AR(), i As Long, S As Variant, Sy As String, Ta As String
    
93.     Dim D As New DataObject, SH As Worksheet
    
94.     On Error GoTo Sh_Err
    
95.     With CreateObject("Scripting.FileSystemObject").OpenTextFile(Code_txt)
    
96.         Ta = .Readall
    
97.         .Close
    
98.     End With
    
99.     With D
    
100.         .SetText Ta
     
101.         .PutInClipboard
     
102.     End With
     
103.     With ThisWorkbook.Sheets(Code)
     
104.         .Range("a1").PasteSpecial
     
105.         If xPage > 1 Then
     
106.             With .Range("A:A").SpecialCells(xlCellTypeConstants).Offset(1)
     
107.                 .Replace "Date", "=xxx", xlWhole
     
108.                 .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
     
109.             End With
     
110.         End If
     
111.         AR = .Range("A:A").SpecialCells(xlCellTypeConstants).Value
     
112.         AR = Application.Transpose(AR)
     
113.          '日期整理 ***************
     
114.         For i = 2 To UBound(AR)
     
115.             S = Split(AR(i), "/")
     
116.             Sy = "20"
     
117.             If Val(S(2)) > Mid(Year(Date), 3) Then Sy = "19"
     
118.             If Len(S(0)) = 2 Then
     
119.                 S = Sy & S(2) & "/" & S(0) & "/" & S(1)
     
120.                 ElseIf Len(S(0)) = 4 Then
     
121.                 S = Sy & S(2) & "/" & Mid(S(0), 3) & "/" & S(1)
     
122.             End If
     
123.             AR(i) = S
     
124.         Next
     
125.         .Range("A:A").SpecialCells(xlCellTypeConstants).Value = Application.Transpose(AR)
     
126.         '*****************************
     
127.         Application.Goto .Range("A1")
     
128.         
     
129.     End With
     
130.     Exit Sub
     
131. Sh_Err:
     
132.     If Err = 9 Then
     
133.         ThisWorkbook.Sheets.Add.Name = Code
     
134.         Err.Clear
     
135.     End If
     
136.     On Error GoTo 0
     
137.     Resume
     
138. End Sub
     
139. Private Sub Set_FormDLL()   '新增引用 Microsoft Forms 2.0 Object Library
     
140.     On Error Resume Next
     
141.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
     
142. End Sub
     
143. Private Sub Remove_FormDLL() '刪除引用 Microsoft Forms 2.0 Object Library
     
144.     Dim D As Object
     
145.     For Each D In ThisWorkbook.VBProject.References
     
146.         If UCase(D.fullpath) Like "*" & FormDLL Then
     
147.             ThisWorkbook.VBProject.References.Remove D
     
148.         End If
     
149.     Next
     
150. End Sub
     
151. Private Sub 網頁的元素()
     
152.     Dim URL As String, A As Object, i As Integer
     
153.     URL = "http://www.cnyes.com/USAstock/history.aspx?code=sgen"
     
154.     With CreateObject("InternetExplorer.Application")
     
155.        ' .Visible = True     '  是否顯示 IE
     
156.         .Navigate URL
     
157.         Do While .readyState <> 4
     
158.             DoEvents
     
159.         Loop
     
160.         Set A = .document.all
     
161.         On Error Resume Next
     
162.         With ActiveSheet
     
163.             .Cells.Clear
     
164.             For i = 0 To A.Length - 1
     
165.                 .Cells(i + 1, "a") = A(i).tagname
     
166.                 .Cells(i + 1, "b") = A(i).ID
     
167.                 .Cells(i + 1, "c") = A(i).Name
     
168.                 .Cells(i + 1, "d") = A(i).Type
     
169.                 .Cells(i + 1, "e") = A(i).Value
     
170.                 .Cells(i + 1, "f") = A(i).innerText
     
171.                 .Cells(i + 1, "g") = A(i).class
     
172.                  .Cells(i + 1, "g") = A(i).class
     
173.             Next
     
174.         End With
     
175.         .Quit
     
176.     End With
     
177. End Sub

複製代碼