GBKEE

¦^´_ 1# BarryHuang621a
§A´£¨Ñ´¼¼z¿ïªÑ¤u¨ãªººô§},¦b§Úªº  XP, IE8  Àô¹Ò¤U°õ¦æ«ÜºC,¦³®É·|±¾±¼

½Ð¸Õ¸Õ§Oªººô§}

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim D  As Object, i As Integer, URL As String
   
4.     URL = "http://forum.twbts.com/thread-12273-1-2.html"
   
5.     'URL = "http://www.goodinfo.tw/stockinfo/StockSorter.asp?"
   
6.     With CreateObject("InternetExplorer.Application")
   
7.         .Navigate URL
   
8.         .Visible = True
   
9.          Do While .ReadyState <> 4 Or .Busy
   
10.             DoEvents
    
11.         Loop
    
12.       
    
13.         Set D = .document.getElementsByTagName("table")
    
14.         ActiveSheet.Cells.Clear
    
15.         For i = 0 To D.Length - 1
    
16.             Ep i, D(i).outerHTML
    
17.         Next
    
18.         .Quit
    
19.     End With
    
20. End Sub
    
21. Private Sub Ep(i As Integer, S As String)
    
22.     Dim R
    
23.     With CreateObject("InternetExplorer.Application")
    
24.         .Navigate "about:Tabs"
    
25.         .Visible = True
    
26.         .document.body.innerhtml = S
    
27.         .ExecWB 17, 2       '  Select All
    
28.         .ExecWB 12, 2       '  Copy selection
    
29.         With ActiveSheet
    
30.             R = IIf(.UsedRange.Rows.Count = 1, 1, .UsedRange.Rows.Count + 2)
    
31.             .Cells(R, 1) = "²Ä " & i & " ­Ó Table"
    
32.             .Cells(R, 1).EntireRow.Interior.Color = vbYellow
    
33.             .UsedRange.Cells(R + 1, 1).Select
    
34.             .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
    
35.         End With
    
36.         .Quit
    
37.     End With
    
38. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 8# BarryHuang621a

1. Excel ¥~³¡¸ê®Æ
   
2. VBA §ì¨úºô­¶¤ºªº¬Y¤@­ÓTable
   
3. Excel VBA §ìHTML ¤¤ªº¬Y¤@­ÓTable

½Æ»s¥N½X

§Aµo¤F³o¨Ç¦³¬ÛÃöªº°ÝÃD,½Ð¤£»Ý¤@ª½ªºµo·s¥DÃD
À°§A¾ã²z¤@¤U,Ãö©ó¥DÃD¤¤ªº¦^ÂÐ,¬O§_§A­nªí¹F©ú¥Õ»P§_,¤£µM¦^ÂЪ̷|ıªº¬O«cÀY¾á¤l¤@ÀY¼ö.


Excel VBA Ū¨úºô·~¦sÀÉ
¸Õ¸Õ¬Ý¬O³o¼Ë¶Ü?

1. Option Explicit
   
2. Private Sub Ex()
   
3.     Dim xml As Object     '¥Î¨Ó¨ú±oºô­¶¸ê®Æ
   
4.     Dim stream            'As ADODB.stream   '¥Î¨ÓÀx¦s¤G¶i¦ìÀÉ®×
   
5.     Dim URL As String     '¥Øªººô§}
   
6.     Dim Title As String
   
7.     Set xml = CreateObject("Microsoft.XMLHTTP")
   
8.     Set stream = CreateObject("ADODB.stream")
   
9.     URL = "https://tw.stock.yahoo.com/q/q?s=2303"
   
10.     xml.Open "POST", URL, 0
    
11.     xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
12.     xml.send
    
13.     Title = Split(xml.responseText, "<title>")(1)
    
14.     Title = Split(Title, "</title>")(0) & ".HTM"   '«ü©wºô­¶ÀɮצWºÙ
    
15.     Title = "D:\" & Title                          'ºô­¶¦sÀɦì¸m
    
16.     With stream
    
17.         .Open
    
18.         .Type = 1
    
19.         .write xml.ResponseBody
    
20.         If Dir(Title) <> "" Then Kill Title
    
21.         .SaveToFile Title
    
22.         .Close
    
23.     End With
    
24.     MsgBox "¦sÀÉ©ó " & Title
    
25. End Sub

½Æ»s¥N½X