[µo°Ý] ¨Ï¥Î msXML2.xmlHTTP ¨ú±oªÑ²¼¥æ©ö¸ê®Æ

Scott090

½Ð°Ý¤j®v«e½ú¦p¦ó¥H xmlhttp ªº¤èªk¨ú±oºô­¶¤¤¦p¤U¹Ïªº¸ê®Æ¡G

¤U¸ü (32.86 KB)

2017-6-26 17:58

1. Sub WebData()
   
2.     Dim strURL$
   
3.     Dim respAA
   
4.     strURL = "https://tw.stock.yahoo.com/q/q?s=2330" 'ºô­¶¦a§}
   
5.     [A1].CurrentRegion = ""
   
6.     Dim oXmlhttp As Object, oHtmldoc As Object
   
7.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
   
8.     Set oHtmldoc = CreateObject("htmlfile")
   
9.     With oXmlhttp
   
10.         .Open "Get", strURL, False
    
11.         .send
    
12.         
    
13.         '-------------------------------------------------
    
14.         '¦p¦ó¨ú±oºô­¶¤¤ªºªí®æ¸ê®Æ?
    
15.         '¤Î ªí®æ¤¤ ²Ä3Äæ²Ä2¦C¸ê®Æ?
    
16.         '-------------------------------------------------
    
17.         
    
18.         
    
19.     End With
    
20. End Sub

½Æ»s¥N½X

«D±`·P®¦

Scott090

¦^´_ 1# Scott090


½Ð°Ý¨º¤@¦ì°ª¤âÄ@·N¨ó§U

ºô­¶¦a§}¦p¤U¡Gl   
https://tw.stock.yahoo.com/q/q?s=2330

ÁÂÁÂ

prin.huang

´£¨Ñ¦Û¤v¼gªºÅª¨útableµ{¦¡½X¡A¦ý®M¥Î¨ì§A´£¨Ñªººô­¶¡AtableŪ¥X¨Ó¥u¦³1­ÓÄæ¦ì¡A¦p¤U¹Ï

"ªÑ²¼
¥N¸¹®É¶¡¦¨¥æ¶R¶i½æ¥Xº¦¶^±i¼Æ¬Q¦¬¶}½L³Ì°ª³Ì§C­ÓªÑ¸ê®Æ
2330¥x¿n¹q
¥[¨ì§ë¸ê²Õ¦X
14:30208.5208.0208.5¡¾1.5 30,867210.0206.5208.5206.5¦¨¥æ©ú²Ó
§Þ³N¡@·s»D
°ò¥»¡@Äw½X
­ÓªÑ°·¶E"

¤£ª¾¦³°ª¤â¦³¤èªk¸Ñ¨M¶Ü¡H

1. Sub main()
   
2. Dim URL$, VV As Boolean, AB() As String
   
3. 
   
4. URL = "https://tw.stock.yahoo.com/q/q?s=2330"
   
5. AB = GetWebTb1(URL, 6, 1, 1, VV)
   
6. If VV = True Then ActiveSheet.Range("A1") = AB
   
7. 
   
8. End Sub
   
9. 
   
10. Private Function GetWebTb1(sURL00$, nTT00%, nRR00%, nCC00%, bRd00 As Boolean)
    
11. '===sURL00      ¬°Â^¨úºô§}
    
12. '===nTT00       ¬°Åª¨ú²Ä´X­ÓTable(±q1¶}©l)
    
13. '===nRR00       ¸ÓTable¥Ñ²Ä´X¦C¶}©lŪ¨ú(±q1¶}©l)
    
14. '===nCC00       ¸ÓTable¥Ñ²Ä´XÄæ¶}©lŪ¨ú(±q1¶}©l)
    
15. '===bRd00       ¸Ó¸ê®Æ¬O§_¿é¥X
    
16. Dim nR00%, nC00%, sTemp() As String, oXml As Object, oDoc As Object, oE As Object, tt As Date
    
17.     Set oXml = CreateObject("MSXML2.XMLHTTP.6.0")
    
18.     Set oDoc = CreateObject("HTMLFile")
    
19.     bRd00 = True
    
20. rSend:
    
21.     tt = Now() + TimeValue("0:00:20")
    
22.     With oXml
    
23.         .Open "Get", sURL00, True
    
24.         .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    
25.         .send
    
26.         On Error Resume Next
    
27.         Do While .ReadyState <> 4 Or .Status <> 200
    
28.             DoEvents
    
29.             If Now > tt Then GoTo rSend
    
30.         Loop
    
31.         On Error GoTo 0
    
32.         oDoc.write .responseText
    
33.     End With
    
34.     If oDoc.all.tags("Table")(nTT00 - 1) Is Nothing Then bRd00 = False: GoTo Err1
    
35.     Set oE = oDoc.all.tags("Table")(nTT00 - 1)
    
36.     With oE
    
37.         ReDim sTemp(.Rows.Length - nRR00, .Rows(nRR00 - 1).Cells.Length - nCC00)
    
38.         For nR00 = 0 To .Rows.Length - nRR00
    
39.             For nC00 = 0 To .Rows(nR00 + nRR00 - 1).Cells.Length - nCC00
    
40.                 sTemp(nR00, nC00) = .Rows(nR00 + nRR00 - 1).Cells(nC00 + nCC00 - 1).innerText
    
41.             Next nC00
    
42.         Next nR00
    
43.     End With
    
44. Err1:
    
45.     GetWebTb1 = sTemp
    
46.     oXml.abort
    
47.     oDoc.Close
    
48.     Set oXml = Nothing
    
49.     Set oDoc = Nothing
    
50.     Set oE = Nothing
    
51. End Function

½Æ»s¥N½X

Scott090

¦^´_ 3# prin.huang


    «D±`·P®¦
´£¨Ñªºcode ¨¬·í¤@­Ó sample¡A ±N¦n¦nªº¬ãŪ¡A¤£¸Ñ¤§³B¦A½Ð¯q´N±Ð

¦A¦¸ªºÁÂÁÂ

GBKEE

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim oXmlhttp As Object, oHtmldoc As Object, surl As String, E As Object, R As Integer, C As Integer
   
4.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
   
5.     Set oHtmldoc = CreateObject("htmlfile")
   
6.     surl = "https://tw.stock.yahoo.com/q/q?s=2330"
   
7.         With oXmlhttp
   
8.         .Open "Get", surl, False
   
9.         .Send
   
10.         oHtmldoc.write .responseText
    
11.     End With
    
12.     ActiveSheet.Cells.Clear
    
13.      With oHtmldoc
    
14.         Set E = .all.tags("table")(6)
    
15.         For R = 0 To E.Rows.Length - 1
    
16.             For C = 0 To E.Rows(R).Cells.Length - 1
    
17.                 ActiveSheet.Cells(R + 1, C + 1) = E.Rows(R).Cells(C).INNERTEXT
    
18.             Next
    
19.         Next
    
20.         ActiveSheet.Cells(R + 1, 1) = Trim(.all.tags("table")(4).INNERTEXT)
    
21.     End With
    
22. End Sub

½Æ»s¥N½X

¦^´_ 4# Scott090

Scott090

¦^´_ 5# GBKEE


    ¤Ó¦n¤F¡A¤S±o¨ì¶W¯Åª©¥Dªº¤j§@
¦Û·í¦n¦nªº¬ã²ß

·PÁÂ

Scott090

¦^´_ 3# prin.huang

Sub main() §@­×¹¢¦p¤U¡A½Ð°Ñ¦Ò

1. Sub main()
   
2. Dim URL$, VV As Boolean, AB() As String
   
3. 
   
4. URL = "https://tw.stock.yahoo.com/q/q?s=2330"
   
5. 
   
6. 'AB = GetWebTb1(URL, 6, 1, 1, VV)
   
7. 'If VV = True Then ActiveSheet.Range("A1") = AB
   
8. 
   
9. AB = GetWebTb1(URL, 7, 1, 1, VV)    '¥Ø¼Ðªí®æ¥Ñ1¶}©l­pºâ¬O²Ä7­Ó
   
10. If VV = True Then ActiveSheet.Range("A1").Resize(UBound(AB, 1) + 1, UBound(AB, 2) + 1) = AB     'AB°}¦C©ñ¤J¤u§@ªíÀx¦s®æ
    
11. 
    
12. End Sub

½Æ»s¥N½X

prin.huang

¦^´_ 7# Scott090

Á°աI±q§Aªºcode¦h¬ù·|¤Fresize³o­Ó¥Îªk¡A¦n¥Î¡I
­ì¨Ó§Útable¼Æ¿ù¤F¡A¬O²Ä¤C­Ó¡A¤£¬O²Ä¤»­Ó¡A
¨ä¹ê§Ú¤£·|¼Æ¨ì©³¬O²Ä´X­Ótable¡A
§Ú¬O¤gªk·Ò¿û¤@­Ó¤@­Ó¿é¥X¡A¬Ý¨ì©³¬O­n¨º¤@­Ótable¡A
µ²ªGÁÙ¬O±Ñ¦b³o¡A¤£ª¾¦³¨S¦³¸û¦³®Ä²vªº¤èªk©O¡H

Scott090

¦^´_ 8# prin.huang


    ¥Î QueryTablesªº¤è¦¡Ą̊úºô­¶¸ê®Æ¡A¿ý»sµ{¦¡½X¡A
µ{¦¡½X¤º .WebTables = "7" ´N¬O¥Ñ1ºâ°_±Æ¦æ²Ä7­Óªí®æ

1. Sub ¥¨¶°1()
   
2. '
   
3. ' ¥¨¶°1 ¥¨¶°
   
4. '
   
5. 
   
6. '
   
7.     With ActiveSheet.QueryTables.Add(Connection:= _
   
8.         "URL;https://tw.stock.yahoo.com/q/q?s=2330", Destination:=Range("$A$1"))
   
9.         .Name = "q?s=2330_1"
   
10.         .FieldNames = True
    
11.         .RowNumbers = False
    
12.         .FillAdjacentFormulas = False
    
13.         .PreserveFormatting = True
    
14.         .RefreshOnFileOpen = False
    
15.         .BackgroundQuery = True
    
16.         .RefreshStyle = xlInsertDeleteCells
    
17.         .SavePassword = False
    
18.         .SaveData = True
    
19.         .AdjustColumnWidth = True
    
20.         .RefreshPeriod = 0
    
21.         .WebSelectionType = xlSpecifiedTables
    
22.         .WebFormatting = xlWebFormattingNone
    
23.         .WebTables = "7"            'Åã¥Ü©Ò­nªº¸ê®Æªí®æ¬O²Ä7­Ó
    
24.         .WebPreFormattedTextToColumns = True
    
25.         .WebConsecutiveDelimitersAsOne = True
    
26.         .WebSingleBlockTextImport = False
    
27.         .WebDisableDateRecognition = False
    
28.         .WebDisableRedirections = False
    
29.         .Refresh BackgroundQuery:=False
    
30.     End With
    
31.     ActiveWorkbook.Connections("³s½u").Delete
    
32. End Sub

½Æ»s¥N½X

¥H¤W¡A½Ð°Ñ¦Ò
ÁÂÁÂ

Scott090

µo²{³o­Óºô¯¸«Üºë±m¡A¥DÃD¬O¡G
"ImportXML, GoogleLookup alternatives for Excel"
http://www.ideativi.it/blog/532/importxml_googlelookup_alternatives_for_excel.aspx

¤º§t¤@­ÓEXCELÀÉ¥i¨Ñ°Ñ¦Ò¡G
" •16/09/2013 importxml.1.10.xlsx (first public release)"

¥H¤W¤À¨É