Private Sub Worksheet_Change(ByVal Target As Range)
Dim xDate As String
Worksheets("匯總").Select
xDate = Worksheets("匯總").Range("B6")
With Target
If .Row = 6 And .Column = 2 Then
If .Value <> 0 Then ' 日期改變觸發下載
Worksheets("加權指").Select
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX.php"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
With .document
.ALL("qdate").Value = Format(xDate, "E/MM/DD") '日期可修改
.ALL("selectType").Value = "MS"
.ALL("query-button").Click
End With
If InStr(.document.BODY.innerText, "查無資料") Then
If xDate = xDate Then '測試用********
'If xDate >= Date Then '正式常程式碼
Debug.Print xDate '驗證用 可刪除
xDate = xDate
End If
'.Quit
MsgBox Format(xDate, "YYYY/M/D") & " 查無資料"
Exit Sub
End If
Set A = .document.GetElementsByTagName("table")
.document.BODY.innerHTML = A(3).outerHTML '取最後的一個"table"
.execwb 17, 1 ' Select All
.execwb 12, 2 ' Copy selection
.Quit '關閉網頁
With Worksheets("加權指").Activate '可指定工作表
Worksheets("加權指").UsedRange.Clear
Worksheets("加權指").Range("A1").Activate
ActiveSheet.PasteSpecial Format:=HTML, Link:=False, DisplayAsIcon:=False, NOHTMLFormatting:=True
Worksheets("加權指").Columns.AutoFit
End With
End With
Else: .Offset(0, 1) = ""
End If
End If
End With
End Sub
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/) |