ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

½Ð°Ý¤j®v«e½ú¦p¦ó¥H xmlhttp ªº¤èªk¨ú±oºô­¶¤¤¦p¤U¹Ïªº¸ê®Æ¡G
qq.JPG
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®¦

¦^´_ 1# Scott090


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

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

ÁÂÁÂ

TOP

´£¨Ñ¦Û¤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. URL = "https://tw.stock.yahoo.com/q/q?s=2330"
  4. AB = GetWebTb1(URL, 6, 1, 1, VV)
  5. If VV = True Then ActiveSheet.Range("A1") = AB

  6. End Sub

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

TOP

¦^´_ 3# prin.huang


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

¦A¦¸ªºÁÂÁÂ

TOP

  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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 5# GBKEE


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

·PÁÂ

TOP

¦^´_ 3# prin.huang

Sub main() §@­×¹¢¦p¤U¡A½Ð°Ñ¦Ò
  1. Sub main()
  2. Dim URL$, VV As Boolean, AB() As String

  3. URL = "https://tw.stock.yahoo.com/q/q?s=2330"

  4. 'AB = GetWebTb1(URL, 6, 1, 1, VV)
  5. 'If VV = True Then ActiveSheet.Range("A1") = AB

  6. AB = GetWebTb1(URL, 7, 1, 1, VV)    '¥Ø¼Ðªí®æ¥Ñ1¶}©l­pºâ¬O²Ä7­Ó
  7. If VV = True Then ActiveSheet.Range("A1").Resize(UBound(AB, 1) + 1, UBound(AB, 2) + 1) = AB     'AB°}¦C©ñ¤J¤u§@ªíÀx¦s®æ

  8. End Sub
½Æ»s¥N½X

TOP

¦^´_ 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

TOP

¦^´_ 8# prin.huang


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

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

TOP

µ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¤À¨É

TOP

        ÀR«ä¦Û¦b : ¦³´¼¼z¤~¯à¤À¿ëµ½´c¨¸¥¿¡F¦³Á¾µê¤~¯à«Ø¥ß¬üº¡¤H¥Í¡C
ªð¦^¦Cªí ¤W¤@¥DÃD