手机快递单号查询系统-快递单号查询系统

此应用是调用网页功能，快速提取数据的一个实例。通过输入快递单号，自动查询快递信息

输入快递单号后，按查询按钮，会显示整个快件从发货到收货的过程，包括时间，地点，途经，操作员等等相关信息。

作者：Excel小子-Office中国

Excel快递单号查询操作动画

  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 With

        End Sub

        Sub 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

            Main

        End Sub