麻辣家族討論版版 - Powered by Discuz! Board

Sub TWSEtest()
Dim sh As Worksheet
Dim iDate$, stock$, yYear$, mMonth$, URL$
Dim arDATA(), Table
Dim i%, j%
Set sh = Sheets("工作表1")
sh.Activate
Cells.Clear
stock = "2330" '設定代號
yYear = "2017" '設定年度
mMonth = "01" '設定月份
iDate = yYear & mMonth & "01"
URL = "http://www.twse.com.tw/exchangeReport/STOCK_DAY_AVG?response=Html&date=" & iDate & "&stockNo=" & stock
With CreateObject("InternetExplorer.Application")
.Visible = False ' 不顯示 IE
.Navigate URL
Do While .readyState <> 4
DoEvents
Loop
Set Table = .document.getElementsBytagname("table")(0)
With Table
ReDim arDATA(.Rows.Length, .Rows(1).Cells.Length)
For i = 0 To .Rows.Length - 1
For j = 0 To .Rows(1).Cells.Length - 1
On Error Resume Next
arDATA(i + 1, j + 1) = .Rows(i).Cells(j).innertext
Next
Next
End With
sh.Cells(1, 1).Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA
[A1].Select
.Quit '關閉瀏覽器
End With
Set Table = Nothing
Set sh = Nothing
Erase arDATA()
End Sub

複製代碼

Option Explicit
Sub Ex_日收盤價及月平均收盤價()
Dim oXmlhttp As Object, oHtmldoc As Object, surl, i, E, r As Double, c As Double
Dim StockNo As String, xday As String, xRow As Integer, Day1 As Date, Day2 As Date, xTime As Date
StockNo = [A2]
Day1 = ActiveSheet.[B2]
Day2 = ActiveSheet.[C2]
For i = 0 To DateDiff("m", Day1, Day2)
xday = Format(DateAdd("m", i, Day1), "yyyymmdd")
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
surl = "http://www.twse.com.tw/exchangeReport/STOCK_DAY_AVG?response=html&date=" & xday & "&stockNo=" & StockNo
With oXmlhttp
.Open "Get", surl, False
.Send
If InStr(.responseText, "很抱歉，沒有符合條件的資料!") Then
MsgBox "很抱歉，沒有符合條件的資料!" & vbLf & "請檢查股票代號"
Exit Sub
ElseIf InStr(.responseText, "查詢日期小於88年1月5日，請重新查詢") Then
MsgBox "查詢日期小於88年1月5日!" & vbLf & "請檢查起始日期"
Exit Sub
ElseIf InStr(.responseText, "查詢日期大於今日，請重新查詢") Then
MsgBox "查詢日期大於今日" & vbLf & "請檢查終止日期"
Exit Sub
End If
oHtmldoc.write .responseText
End With
With oHtmldoc
Set E = .all.tags("table")(0)
With ActiveSheet
If i = 0 Then .UsedRange.Offset(2).Clear
xRow = .Cells(Rows.Count, "a").End(xlUp).Row + IIf(i = 0, 1, 0)
For r = IIf(i = 0, 0, 2) To E.Rows.Length - 2 '-1 可顯示月平均收盤價
For c = 0 To E.Rows(r).Cells.Length - 1
.Cells(xRow + r + IIf(i > 0, -1, 0), c + 1) = E.Rows(r).Cells(c).innertext
Next
Next
End With
End With
Set oXmlhttp = Nothing
Set oHtmldoc = Nothing
Application.StatusBar = "**** " & Format(DateAdd("m", i, Day1), "ee/mm") & " 載完畢 *****"
'**** 股市營業時間有流量管制 **
'xTime = Time + #12:00:09 AM# '間隔 10秒
'Do : DoEvents: Loop Until Time > xTime
'**********或是下式**********************
'Application.Wait Now + #12:00:09 AM#
'********************************
Next
MsgBox "ok"
End Sub

複製代碼