|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
代码如下:之前可以获得数据,目前 获得均为空值
- Sub IND()
- Dim url, html
- url = "http://www.cde.org.cn/transparent.do?method=spxlList&tasktype=xb&acceptid=&applyTypeCde=IND&isTimetag=0&pageMaxNumber=10000&pagenum=1"
- Set html = CreateObject("htmlfile")
- n = 2
- ar = Evaluate("{""排队序号"",""受理号"",""药品名称"",""进入中心时间"",""审评状态"",""药理毒理"",""临床"",""药学"",""备注"",""目前所在序列"",""数据采集日期""}")
- Cells.ClearContents
- Range("a2").Resize(1, UBound(ar)) = ar
- With CreateObject("msxml2.xmlhttp")
- .Open "get", url, False
- .send
- html.body.innerhtml = .responsetext
- Set tb = html.all.tags("tr")
- For i = 0 To tb.Length - 1
- If tb(i).bgcolor = "#f5fafe" Then
- n = n + 1
- For j = 0 To 4
- Cells(n, j + 1) = tb(i).Cells(j).innertext
- Next
- Cells(n, 9) = tb(i).Cells(8).innertext
- For j = 5 To 7
- If InStr(tb(i).Cells(j).innerhtml, "lamp_shut.gif") > 0 Then
- Cells(n, j + 1) = "灯灭"
- ElseIf InStr(tb(i).Cells(j).innerhtml, "lamp_y.jpg") Then
- Cells(n, j + 1) = "黄灯"
- ElseIf InStr(tb(i).Cells(j).innerhtml, "lamp.gif") Then
- Cells(n, j + 1) = "绿灯"
- End If
- Next
- Cells(n, 10).Resize(1, 1) = "化药IND"
- Cells(n, 11).Resize(1, 1) = Now()
- End If
-
- Next
- End With
-
- End Sub
复制代码
|
|