Dim?arr(1?To?10,?1?To?4),?Company,?Sdata$,?brr,?x
Cells.Clear
On?Error?Resume?Next
Set?oDoc?=?CreateObject("htmlfile")
[a1:d1]?=?Array("公司信息",?"註冊資本",?"成立時間",?"公司狀態")
Company?=?Application.InputBox("請輸入妳要查詢的公司名稱關鍵字：",?"請輸入關鍵字")
If?Company?=?False?Then?Exit?Sub
If?Company?=?""?Then?Exit?Sub
With?CreateObject("MSXML2.XMLHTTP")
.Open?"GET",?"
(Company)?&?"&index=",?False
.Send
oDoc.body.innerHTML?=?.responsetext
Set?r?=?oDoc.All.tags("table")(0).Rows
For?i?=?1?To?r.Length?-?1
k?=?k?+?1
For?x?=?1?To?4
arr(k,?x)?=?r(i).Cells(x).innerText
Next
Next
End?With
Range("A2").Resize(k,?4)?=?arr
Range("A1").CurrentRegion.HorizontalAlignment?=?xlLeft
Columns.AutoFit
End?Sub
如果運行沒有想要的結果，請告知妳使用的excel版本，針對版本更改壹下代碼即可，理論上，以上代碼適用於2010版本以上