GBKEE

¦^´_ 1# paul3063

2017-12-19 18:39

¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex_¤é¦¬½L»ù¤Î¤ë¥­§¡¦¬½L»ù()
   
3.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, i, E, r As Double, c As Double
   
4.     Dim StockNo As String, xday As String, xRow As Integer, Day1 As Date, Day2 As Date, xTime As Date
   
5.      StockNo = [A2]
   
6.      Day1 = ActiveSheet.[B2]
   
7.      Day2 = ActiveSheet.[C2]
   
8.     For i = 0 To DateDiff("m", Day1, Day2)
   
9.         xday = Format(DateAdd("m", i, Day1), "yyyymmdd")
   
10.         Set oXmlhttp = CreateObject("msxml2.xmlhttp")
    
11.         Set oHtmldoc = CreateObject("htmlfile")
    
12.         surl = "http://www.twse.com.tw/exchangeReport/STOCK_DAY_AVG?response=html&date=" & xday & "&stockNo=" & StockNo
    
13.         With oXmlhttp
    
14.             .Open "Get", surl, False
    
15.             .Send
    
16.             If InStr(.responseText, "«Ü©êºp¡A¨S¦³²Å¦X±ø¥óªº¸ê®Æ!") Then
    
17.                 MsgBox "«Ü©êºp¡A¨S¦³²Å¦X±ø¥óªº¸ê®Æ!" & vbLf & "½ÐÀˬd ªÑ²¼¥N¸¹"
    
18.                 Exit Sub
    
19.             ElseIf InStr(.responseText, "¬d¸ß¤é´Á¤p©ó88¦~1¤ë5¤é¡A½Ð­«·s¬d¸ß") Then
    
20.                 MsgBox "¬d¸ß¤é´Á¤p©ó88¦~1¤ë5¤é!" & vbLf & "½ÐÀˬd °_©l¤é´Á"
    
21.                 Exit Sub
    
22.             ElseIf InStr(.responseText, "¬d¸ß¤é´Á¤j©ó¤µ¤é¡A½Ð­«·s¬d¸ß") Then
    
23.                 MsgBox "¬d¸ß¤é´Á¤j©ó¤µ¤é" & vbLf & "½ÐÀˬd ²×¤î¤é´Á"
    
24.                 Exit Sub
    
25.             End If
    
26.             oHtmldoc.write .responseText
    
27.         End With
    
28.         With oHtmldoc
    
29.             Set E = .all.tags("table")(0)
    
30.             With ActiveSheet
    
31.                 If i = 0 Then .UsedRange.Offset(2).Clear
    
32.                 xRow = .Cells(Rows.Count, "a").End(xlUp).Row + IIf(i = 0, 1, 0)
    
33.                
    
34.                 For r = IIf(i = 0, 0, 2) To E.Rows.Length - 2 '-1 ¥iÅã¥Ü¤ë¥­§¡¦¬½L»ù
    
35.                     For c = 0 To E.Rows(r).Cells.Length - 1
    
36.                     .Cells(xRow + r + IIf(i > 0, -1, 0), c + 1) = E.Rows(r).Cells(c).innertext
    
37.                     Next
    
38.                 Next
    
39.             End With
    
40.     End With
    
41.     Set oXmlhttp = Nothing
    
42.     Set oHtmldoc = Nothing
    
43.     Application.StatusBar = "****  " & Format(DateAdd("m", i, Day1), "ee/mm") & "  ¸ü§¹²¦ *****"
    
44.     '**** ªÑ¥«Àç·~®É¶¡¦³¬y¶qºÞ¨î **
    
45.     'xTime = Time + #12:00:09 AM#   '¶¡¹j 10¬í
    
46.     'Do :    DoEvents:    Loop Until Time > xTime
    
47.    '**********©Î¬O¤U¦¡**********************
    
48.     'Application.Wait Now + #12:00:09 AM#
    
49.     '********************************
    
50.     Next
    
51.     MsgBox "ok"
    
52. End Sub

½Æ»s¥N½X