snare wrote:
這個問題我有提供vba(恕刪)
這個提供參考
可以真的去抓每個欄位資料
而不是用空格去判斷
喜歡爬資料的話
建議了解一下 DOM (Document Object Model)
會很有幫助
' 從暫存檔案中讀取
Function GetFromCacheFile()
Dim MyTextFile As String, TextLine As String, ResultText As String
Dim FileId As Integer
MyTextFile = "C:\tmpfile.html"
FileId = FreeFile()
ResultText = ""
Open MyTextFile For Input As FileId
While Not EOF(FileId)
Line Input #FileId, TextLine
ResultText = ResultText & Chr(10) & TextLine
Wend
GetFromCacheFile = ResultText
End Function
' 從網站抓資料
Function GetFromUrl()
Dim Url As String, GetXml As Object
Url = "http://5850web.moneydj.com/z/zc/zcr/zcra/zcra_6203.djhtm"
Set GetXml = CreateObject("msxml2.xmlhttp")
GetFromUrl = ""
With GetXml
.Open "GET", Url, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
GetFromUrl = .ResponseText
End With
End Function
'更新
Sub UpdateData()
Dim HTML As Object, TheSheet As Object
Dim Divs As Object, idx As Integer, Div As Object
Dim Spans As Object, idx2 As Integer
Set TheSheet = Sheets("工作表1")
Set HTML = CreateObject("htmlfile")
' 開發測試時可以改用 GetFromCacheFile() 從暫存檔抓資料
' 避免頻繁的發出請求
'（需要預先把網站的內容儲存到 C:\tmpfile.html）
HTML.Body.InnerHtml = GetFromUrl()
'公司名稱
Set Divs = HTML.querySelector("#oScrollHead")
TheSheet.Cells(1, 1) = Divs.ChildNodes.Item(0).textContent
'每個表
Set Divs = HTML.querySelectorAll("#oMainTable>tbody>tr>td>div")
For idx = 1 To Divs.Length - 1
Set Div = Divs.Item(idx)
If Div.classList.contains("table-caption") Then
'標題
TheSheet.Cells(idx + 1, 1) = Divs.Item(idx).textContent
Else
'列資料
Set Spans = Div.querySelectorAll("span")
For idx2 = 0 To Spans.Length - 1
TheSheet.Cells(idx + 1, idx2 + 1) = Spans.Item(idx2).textContent
Next idx2
End If
Next idx
End Sub
