ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ·Q½Ð±Ð¤@­Ó§ì¾ú¥vªÑ»ùªºµ{¦¡

¤£¦n·N«ä §Ú¥i¯à»Ý­nª©¥D±z´£ÂI§Ú¤@¤U
¹Ï¤ù¤¤ ¨º­Ó¤é´Á¦³¤@­Ó¬O¤U©Ô ¨ä¥¦¤G­Ó¬O¥Î¶ñ­Èªº §Ú¤£ª¾³oºØªº«ç»ò¼g
§Ú·|¼g¤@­Ó«á ´N·|§ï¦¨¥Î°j°é¨Ó§ì¨ú§Ú»Ý­nªº­È¤F

SGEN.jpg (137.23 KB)

SGEN.jpg

¤pµæ³¾¤@­Ó ½Ð¦h«ü±Ð~

TOP

¦^´_ 11# kasl
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Const Code_txt = "D:\Code.Txt"
  3. Const FormDLL = "FM20.DLL"
  4. Sub Ex_Ie_¤U¤@­¶()
  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¦~«eªº¤é´Á
  10.     'StartDate = DateAdd("m", -1, Date)    '1­Ó¤ë«eªº¤é´Á
  11.     EndDate = Date
  12.     MsgBox EndDate & " -- " & StartDate
  13.     Ar_Code = Array("sgen", "AMEH", "HMNC")  'Code ªº°}¦C
  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     '  ¬O§_Åã¥Ü 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 & " «ü©w¤¤..."

  29.             With .document.getElementsByTagName("SELECT")           '¤ë¥÷¿é¤J
  30.                 .Item("startMonth").Value = Month(StartDate) - 1    '¶}©l¤ë¥÷
  31.                 .Item("endMonth").Value = Month(EndDate) - 1        'µ²§ô¤ë¥÷
  32.             End With
  33.             With .document.getElementsByTagName("INPUT")
  34.                 .Item("startDay").Value = Day(StartDate)            '¶}©l¤é´Á
  35.                 .Item("startDay").Value = Day(StartDate)            '¶}©l¤é´Á
  36.                 .Item("startYear").Value = Year(StartDate)          '¶}©l¦~«×
  37.                 .Item("endDay").Value = Day(EndDate)                'µ²§ô¤é´Á
  38.                 .Item("endYear").Value = Year(EndDate)              'µ²§ô¦~«×
  39.                 .Item("perPage").Value = 100                        'Åã¥Ü¸ê®Æªºµ§¼Æ
  40.             End With
  41.             For Each E In .document.getElementsByTagName("BUTTON")
  42.                 If E.Type = "submit" Then
  43.                     E.Click                                         '«ö¤U·j´MÁä
  44.                     Exit For
  45.                 End If
  46.             Next
  47.             Application.StatusBar = "«ö¤U·j´MÁä µ¥­Ôºô­¶¤¤... "
  48.             Do While .Busy Or .readyState <> 4:   DoEvents:       Loop
  49.             Application.Wait Time + #12:00:10 AM#                   'µ¥­Ôºô­¶
  50.             Set Table = .document.getElementsByTagName("TABLE")
  51.             For Each E In .document.getElementsByTagName("SPAN")
  52.                 If InStr(E.innerText, "Page   of") Then
  53.                     i = Val(Replace(E.innerText, "Page   of", ""))   '¨ú±o¸ê®ÆÁ`­¶¼Æ
  54.                     Exit For
  55.                 End If
  56.             Next
  57.             On Error GoTo Ie_Err
  58.             For A = 0 To i
  59.                 Application.StatusBar = Code & "  " & EndDate & " -- " & StartDate & "¦@ " & i & " ­¶ ¤U¸ü  ²Ä " & A + IIf(A = 0, 1, 0) & " ¤¤..."
  60.                 For Each E In .document.getElementsByTagName("A")
  61.                     If Trim(E.innerText) = ">" Then
  62.                         If A > 1 Then E.Click                          '¤U¤@­¶«öÁä
  63.                             Do While .Busy Or .readyState <> 4:   DoEvents:       Loop
  64.                             Application.Wait Time + #12:00:05 AM#                'µ¥­Ôºô­¶
  65.                             Set Table = .document.getElementsByTagName("TABLE")
  66.                             Exit For
  67.                         End If
  68.                 Next
  69.                 If A = 0 Or A > 1 Then
  70.                 Close #1
  71.                 Open Code_txt For Append As #1
  72.                 Print #1, Table(12).outerHTML
  73.                 Close #1
  74.                 End If
  75.             Next
  76.             Date_of_refresh Code, A  '¾É¤J¸ê®Æµ{¦¡ ­nµ¹°Ñ¼Æ Code , A
  77. Code_Next:
  78.         Next
  79.         .Quit
  80.     End With
  81.     Application.StatusBar = False
  82.     Remove_FormDLL
  83.     MsgBox "Ok"
  84.     Exit Sub
  85. Ie_Err:
  86.     Application.Wait Time + #12:00:05 AM#                'µ¥­Ôºô­¶
  87.     Set Table = IE.document.getElementsByTagName("TABLE")
  88.     Resume
  89. End Sub
  90. Private Sub Date_of_refresh(ByVal Code As String, ByVal xPage As Integer) '¾É¤J¸ê®Æµ{¦¡
  91.     Dim AR(), i As Long, S As Variant, Sy As String, Ta As String
  92.     Dim D As New DataObject, SH As Worksheet
  93.     On Error GoTo Sh_Err
  94.     With CreateObject("Scripting.FileSystemObject").OpenTextFile(Code_txt)
  95.         Ta = .Readall
  96.         .Close
  97.     End With
  98.     With D
  99.         .SetText Ta
  100.         .PutInClipboard
  101.     End With
  102.     With ThisWorkbook.Sheets(Code)
  103.         .Range("a1").PasteSpecial
  104.         If xPage > 1 Then
  105.             With .Range("A:A").SpecialCells(xlCellTypeConstants).Offset(1)
  106.                 .Replace "Date", "=xxx", xlWhole
  107.                 .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
  108.             End With
  109.         End If
  110.         AR = .Range("A:A").SpecialCells(xlCellTypeConstants).Value
  111.         AR = Application.Transpose(AR)
  112.          '¤é´Á¾ã²z ***************
  113.         For i = 2 To UBound(AR)
  114.             S = Split(AR(i), "/")
  115.             Sy = "20"
  116.             If Val(S(2)) > Mid(Year(Date), 3) Then Sy = "19"
  117.             If Len(S(0)) = 2 Then
  118.                 S = Sy & S(2) & "/" & S(0) & "/" & S(1)
  119.                 ElseIf Len(S(0)) = 4 Then
  120.                 S = Sy & S(2) & "/" & Mid(S(0), 3) & "/" & S(1)
  121.             End If
  122.             AR(i) = S
  123.         Next
  124.         .Range("A:A").SpecialCells(xlCellTypeConstants).Value = Application.Transpose(AR)
  125.         '*****************************
  126.         Application.Goto .Range("A1")
  127.         
  128.     End With
  129.     Exit Sub
  130. Sh_Err:
  131.     If Err = 9 Then
  132.         ThisWorkbook.Sheets.Add.Name = Code
  133.         Err.Clear
  134.     End If
  135.     On Error GoTo 0
  136.     Resume
  137. End Sub
  138. Private Sub Set_FormDLL()   '·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library
  139.     On Error Resume Next
  140.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
  141. End Sub
  142. Private Sub Remove_FormDLL() '§R°£¤Þ¥Î Microsoft Forms 2.0 Object Library
  143.     Dim D As Object
  144.     For Each D In ThisWorkbook.VBProject.References
  145.         If UCase(D.fullpath) Like "*" & FormDLL Then
  146.             ThisWorkbook.VBProject.References.Remove D
  147.         End If
  148.     Next
  149. End Sub
  150. Private Sub ºô­¶ªº¤¸¯À()
  151.     Dim URL As String, A As Object, i As Integer
  152.     URL = "http://www.cnyes.com/USAstock/history.aspx?code=sgen"
  153.     With CreateObject("InternetExplorer.Application")
  154.        ' .Visible = True     '  ¬O§_Åã¥Ü IE
  155.         .Navigate URL
  156.         Do While .readyState <> 4
  157.             DoEvents
  158.         Loop
  159.         Set A = .document.all
  160.         On Error Resume Next
  161.         With ActiveSheet
  162.             .Cells.Clear
  163.             For i = 0 To A.Length - 1
  164.                 .Cells(i + 1, "a") = A(i).tagname
  165.                 .Cells(i + 1, "b") = A(i).ID
  166.                 .Cells(i + 1, "c") = A(i).Name
  167.                 .Cells(i + 1, "d") = A(i).Type
  168.                 .Cells(i + 1, "e") = A(i).Value
  169.                 .Cells(i + 1, "f") = A(i).innerText
  170.                 .Cells(i + 1, "g") = A(i).class
  171.                  .Cells(i + 1, "g") = A(i).class
  172.             Next
  173.         End With
  174.         .Quit
  175.     End With
  176. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¨C¤ÑµL©Ò¨Æ¨Æ¡A¬O¤H¥Íªº®ø¶OªÌ¡A¿n·¥¡B¦³¥Î¤~¬O¤H¥Íªº³Ð³yªÌ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD