|
楼主 |
发表于 2011-3-9 09:32
|
显示全部楼层
Sub 提取淘宝ID()
Application.EnableEvents = False
On Error Resume Next
Dim nRow%, cTxt$, ARR(), Brr()
nRow = ActiveSheet.Range("e65536").End(xlUp).Row
ARR = Range("E7:E" & nRow).Value
ReDim Brr(7 To nRow, 7 To 1)
With CreateObject("Microsoft.XMLHTTP")
For I = 1 To nRow
DoEvents
.Open "POST", ARR(I, 7), False
.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
.Send
Do While Not .READYSTATE = 4
DoEvents
Loop
cTxt = Split(Split(Split(Split(Split(.responsetext, "请进入", , 1)(2), "淘宝网首页", , 1)(4), "更多充值平台加款卡", , 1)(6), "铺", , 1)(1), "的", , 1)(0)
If Err = 0 Then Brr(I, 7) = cTxt
Err.Clear
Next
End With
ActiveSheet.Range("G7:G" & nRow).Value = Brr
Application.EnableEvents = True
End Sub |
|