此应用是调用网页功能,快速提取数据的一个实例。通过输入快递单号,自动查询快递信息输入快递单号后,按查询按钮,会显示整个快件从发货到收货的过程,包括时间,地点,途经,操作员等等相关信息。
作者:Excel小子-Office中国Excel快递单号查询操作动画
1481873538195923.gif
Excel快递单号查询详细VBA代码: Sub Main() Dim strText As String Dim sjs Dim i Randomize sjs = Rnd Dim re, m Set re = CreateObject("vbscript.regexp") re.Global = True re.Pattern = "ftime""\:""([^""]+)""\,""context"":""([^""]+)" With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1") ' .Open "GET", "http://www.kuaidi100.com/query?type=" & kuaidi & "&postid=" & Cells(1, 5) & "&id=1&valicode=&temp=" & sjs, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .setRequestHeader "Referer", "" .Send strText = .responsetext Set m = re.Execute(strText) Range("A:C").ClearContents For Each m In m i = i + 1 Cells(i, 1) = m.submatches(0) Cells(i, 3) = m.submatches(1) Next m Debug.Print strText End WithEnd SubSub Main1() Dim strText As String Dim re, m Set re = CreateObject("vbscript.regexp") re.Global = True re.Pattern = "\[\{""comCode""\:""([^""]+)" With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1") ' .Open "POST", "http://www.kuaidi100.com/autonumber/autoComNum?text=" & Cells(1, 5), False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .setRequestHeader "Referer", "" .Send strText = .responsetext Set m = re.Execute(strText) kuaidi = m(0).submatches(0) Debug.Print kuaidi Cells(1, 4) = Sheets(3).Range("A:A").Find(kuaidi).Offset(0, 1) End With MainEnd Sub |