- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 11# kasl
¸Õ¸Õ¬Ý- Option Explicit
- Const Code_txt = "D:\Code.Txt"
- Const FormDLL = "FM20.DLL"
- Sub Ex_Ie_¤U¤@¶()
- Dim IE As Object, URL As String, E As Variant, i As Integer
- Dim StartDate As Date, EndDate As Date
- Dim A As Variant, Table As Object, Ar_Code(), Code As Variant
- Set_FormDLL
- StartDate = DateAdd("yyyy", -1, Date) '1¦~«eªº¤é´Á
- 'StartDate = DateAdd("m", -1, Date) '1Ó¤ë«eªº¤é´Á
- EndDate = Date
- MsgBox EndDate & " -- " & StartDate
- Ar_Code = Array("sgen", "AMEH", "HMNC") 'Code ªº°}¦C
- 'Ar_Ccod() = Array("sgen", "AMEH", "HMNC", "OZM", "ARCC", "TDG", "ECL", "AN")
- Set IE = CreateObject("InternetExplorer.Application")
- With IE
- For Each Code In Ar_Code
- If Dir(Code_txt) <> "" Then Kill Code_txt
- URL = "http://www.cnyes.com/USAstock/history.aspx?code=" & Code
- ' .Visible = True ' ¬O§_Åã¥Ü IE
- .Navigate URL
- Application.StatusBar = Code & " ºô¶ ¶}±Ò¤¤..."
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- If .LocationURL = "http://www.cnyes.com/usastock/index.htm" Then
- MsgBox "Code §ä¤£¨ì " & Code
- GoTo Code_Next
- End If
- Application.StatusBar = Code & "¤é´Á " & EndDate & " -- " & StartDate & " «ü©w¤¤..."
- With .document.getElementsByTagName("SELECT") '¤ë¥÷¿é¤J
- .Item("startMonth").Value = Month(StartDate) - 1 '¶}©l¤ë¥÷
- .Item("endMonth").Value = Month(EndDate) - 1 'µ²§ô¤ë¥÷
- End With
- With .document.getElementsByTagName("INPUT")
- .Item("startDay").Value = Day(StartDate) '¶}©l¤é´Á
- .Item("startDay").Value = Day(StartDate) '¶}©l¤é´Á
- .Item("startYear").Value = Year(StartDate) '¶}©l¦~«×
- .Item("endDay").Value = Day(EndDate) 'µ²§ô¤é´Á
- .Item("endYear").Value = Year(EndDate) 'µ²§ô¦~«×
- .Item("perPage").Value = 100 'Åã¥Ü¸ê®Æªºµ§¼Æ
- End With
- For Each E In .document.getElementsByTagName("BUTTON")
- If E.Type = "submit" Then
- E.Click '«ö¤U·j´MÁä
- Exit For
- End If
- Next
- Application.StatusBar = "«ö¤U·j´MÁä µ¥Ôºô¶¤¤... "
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Application.Wait Time + #12:00:10 AM# 'µ¥Ôºô¶
- Set Table = .document.getElementsByTagName("TABLE")
- For Each E In .document.getElementsByTagName("SPAN")
- If InStr(E.innerText, "Page of") Then
- i = Val(Replace(E.innerText, "Page of", "")) '¨ú±o¸ê®ÆÁ`¶¼Æ
- Exit For
- End If
- Next
- On Error GoTo Ie_Err
- For A = 0 To i
- Application.StatusBar = Code & " " & EndDate & " -- " & StartDate & "¦@ " & i & " ¶ ¤U¸ü ²Ä " & A + IIf(A = 0, 1, 0) & " ¤¤..."
- For Each E In .document.getElementsByTagName("A")
- If Trim(E.innerText) = ">" Then
- If A > 1 Then E.Click '¤U¤@¶«öÁä
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- Application.Wait Time + #12:00:05 AM# 'µ¥Ôºô¶
- Set Table = .document.getElementsByTagName("TABLE")
- Exit For
- End If
- Next
- If A = 0 Or A > 1 Then
- Close #1
- Open Code_txt For Append As #1
- Print #1, Table(12).outerHTML
- Close #1
- End If
- Next
- Date_of_refresh Code, A '¾É¤J¸ê®Æµ{¦¡ nµ¹°Ñ¼Æ Code , A
- Code_Next:
- Next
- .Quit
- End With
- Application.StatusBar = False
- Remove_FormDLL
- MsgBox "Ok"
- Exit Sub
- Ie_Err:
- Application.Wait Time + #12:00:05 AM# 'µ¥Ôºô¶
- Set Table = IE.document.getElementsByTagName("TABLE")
- Resume
- End Sub
- Private Sub Date_of_refresh(ByVal Code As String, ByVal xPage As Integer) '¾É¤J¸ê®Æµ{¦¡
- Dim AR(), i As Long, S As Variant, Sy As String, Ta As String
- Dim D As New DataObject, SH As Worksheet
- On Error GoTo Sh_Err
- With CreateObject("Scripting.FileSystemObject").OpenTextFile(Code_txt)
- Ta = .Readall
- .Close
- End With
- With D
- .SetText Ta
- .PutInClipboard
- End With
- With ThisWorkbook.Sheets(Code)
- .Range("a1").PasteSpecial
- If xPage > 1 Then
- With .Range("A:A").SpecialCells(xlCellTypeConstants).Offset(1)
- .Replace "Date", "=xxx", xlWhole
- .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
- End With
- End If
- AR = .Range("A:A").SpecialCells(xlCellTypeConstants).Value
- AR = Application.Transpose(AR)
- '¤é´Á¾ã²z ***************
- For i = 2 To UBound(AR)
- S = Split(AR(i), "/")
- Sy = "20"
- If Val(S(2)) > Mid(Year(Date), 3) Then Sy = "19"
- If Len(S(0)) = 2 Then
- S = Sy & S(2) & "/" & S(0) & "/" & S(1)
- ElseIf Len(S(0)) = 4 Then
- S = Sy & S(2) & "/" & Mid(S(0), 3) & "/" & S(1)
- End If
- AR(i) = S
- Next
- .Range("A:A").SpecialCells(xlCellTypeConstants).Value = Application.Transpose(AR)
- '*****************************
- Application.Goto .Range("A1")
-
- End With
- Exit Sub
- Sh_Err:
- If Err = 9 Then
- ThisWorkbook.Sheets.Add.Name = Code
- Err.Clear
- End If
- On Error GoTo 0
- Resume
- End Sub
- Private Sub Set_FormDLL() '·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library
- On Error Resume Next
- ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
- End Sub
- Private Sub Remove_FormDLL() '§R°£¤Þ¥Î Microsoft Forms 2.0 Object Library
- Dim D As Object
- For Each D In ThisWorkbook.VBProject.References
- If UCase(D.fullpath) Like "*" & FormDLL Then
- ThisWorkbook.VBProject.References.Remove D
- End If
- Next
- End Sub
- Private Sub ºô¶ªº¤¸¯À()
- Dim URL As String, A As Object, i As Integer
- URL = "http://www.cnyes.com/USAstock/history.aspx?code=sgen"
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True ' ¬O§_Åã¥Ü IE
- .Navigate URL
- Do While .readyState <> 4
- DoEvents
- Loop
- Set A = .document.all
- On Error Resume Next
- With ActiveSheet
- .Cells.Clear
- For i = 0 To A.Length - 1
- .Cells(i + 1, "a") = A(i).tagname
- .Cells(i + 1, "b") = A(i).ID
- .Cells(i + 1, "c") = A(i).Name
- .Cells(i + 1, "d") = A(i).Type
- .Cells(i + 1, "e") = A(i).Value
- .Cells(i + 1, "f") = A(i).innerText
- .Cells(i + 1, "g") = A(i).class
- .Cells(i + 1, "g") = A(i).class
- Next
- End With
- .Quit
- End With
- End Sub
½Æ»s¥N½X |
|