楼主
liuguansky |
Q:如何在网页中查询相应电子箱单号对应的信息,并在另外表中返回,一个单号对应多条信息的,分开返回.
A:用如下代码可以实现:
- Sub justtest()
- Dim Arr, i&, GetC$, ArrGet, k&, ArrRes(), j%, m As Byte '定义变量
- Arr = Range(Cells(2, 3), Cells(Rows.Count, 3).End(3)).Value '获取待处理区域,赋值予数组
- With CreateObject("microsoft.xmlhttp") '创建XMLHTTP对象,用于处理网页数据
- For i = 1 To UBound(Arr, 1) '循环待处理单号
- If Len(Trim(Arr(i, 1))) Then '如果单号非空
- .Open "get", "http://edi.easipass.com/dataportal/query.do?ctno=&blno=" _
- & Trim(Arr(i, 1)) & "&qn=dp_cst_vsl", False '创建打开查询对应单号界面
- .setRequestHeader "If-Modified-Since", Format(Now, "[$-F800]dddd, mmmm dd, yyyy") & " GMT" '防止从滞留页面读取数据
- .send '读取
- GetC = .responsetext '返回查询结果文本
- k = k + 1 '初始化变量
- ReDim Preserve ArrRes(1 To 9, 1 To k) '定义动态数组,用于存储返回结果
- If InStr(1, GetC, "INFO:查不到您所需要的电子装箱单") Then '判断箱号是否存在,如果不存在,则进行提示
- ArrRes(1, k) = Arr(i, 1)
- ArrRes(2, k) = "INFO:查不到您所需要的电子装箱单"
- Else '如果存在,则进行下面处理
- With CreateObject("vbscript.regexp") '创建正则对象,对文本进行处理
- .Global = True
- .MultiLine = True
- .Pattern = "(<.*?>)"
- GetC = Replace((.Replace(GetC, "")), " ", "") '依待提取数据去除多余项目,留下待处理字符串
- GetC = Mid(GetC, InStr(1, GetC, "COSTRP号") + 7)
- GetC = Left(GetC, InStr(1, GetC, "Copyright") - 1)
- .Pattern = "\s+"
- GetC = .Replace(GetC, " ")
- ArrGet = Split(GetC) '生成提取数据的数组
- k = k - 1
- For j = 1 To UBound(ArrGet) - 1 Step 8 '对结果数组进行赋值
- k = k + 1
- ReDim Preserve ArrRes(1 To 9, 1 To k)
- ArrRes(1, k) = Arr(i, 1)
- For m = 1 To 8
- ArrRes(1 + m, k) = ArrGet(j + m - 1)
- Next m
- Next j
- End With
- End If
- End If
- Next i
- With Sheet2
- .Range("a2:i" & .Rows.Count).ClearContents '清除待返回区域内容
- .Range("a2").Resize(k, 9) = Application.Transpose(ArrRes) '赋值
- End With
- End With
- End Sub
|