zoukankan      html  css  js  c++  java
  • 【VBA研究】VBA通过HTTP协议实现邮件轨迹跟踪查询

    作者:iamlasong

    1、接口说明

    通过互联网訪问,运单跟踪信息查询接口基于HTTP协议开发,接口为RESTFul风格的Web Service,信息交互过程为用户按我方提供的web service地址进行调用,我方接到调用请求后,为用户返回JSON格式组织的数据信息。用户根据约定的接口规范对数据进行解析。

    接口调用为HTTP请求的方式,每一次由用户发起的HTTP请求,须要设置验证信息,详细方法是,在HTTP Header部分添加version及authenticate属性,属性值在联调測试之前由总部提供。

    接口调用地址:http:// IP:Port/invoke/path/{mail_num}

    接口调用方式:HTTP GET方式,通过HTTP GET发起请求,使用真实邮件号替换{mail_num}

    编码格式:UTF-8

    接口返回数据格式:

    {"traces":[{"acceptTime":"2011-11-2417:55:00","acceptAddress":"上海邮政速递物流长宁经营部","remark":"收寄"},{"acceptTime":"2011-11-2417:59:00","acceptAddress":"上海邮政速递物流长宁经营部","remark":"离开处理中心,发往上海市邮政公司邮政速递局"},{"acceptTime":"2011-11-2423:54:38","acceptAddress":"上海市","remark":"到达处理中心,来自上海邮政速递物流长宁经营部"},{"acceptTime":"2011-11-2500:17:42","acceptAddress":"上海市","remark":"离开处理中心,发往USSFOF"},{"acceptTime":"2011-12-0507:41:00","acceptAddress":"美国 94704","remark":"到达投递局"},{"acceptTime":"2011-12-0511:07:00","acceptAddress":"美国94703","remark":"妥投"}]}

    acceptTime表示处理时间

    acceptAddress表示处理地点

    remark表示处理动作

    2、查询界面


    3、查询结果


    4、程序实现

    <pre name="code" class="vb">Dim tt, stime(80), saddr(80), state(80) As String
    
    Public Sub get_data()
        '
        Dim HttpReq As Object
        Dim i, k, kk, row1 As Integer
        
        lineno = [A65536].End(xlUp).Row      '行数
        Range("B2:B" & lineno).ClearContents
        'lineno = ActiveSheet.UsedRange.Rows.Count
        Set HttpReq = CreateObject("MSXML2.XMLHTTP.3.0")
        
        row1 = 2
        maxrow = Sheets("查询结果").UsedRange.Rows.Count
        If maxrow >= 2 Then
            Sheets("查询结果").Range("A2:D" & maxrow).ClearContents
        End If
        For i = 2 To lineno
            mail = Cells(i, 1)
            If mail = "" Then Exit For
            '以下的<span style="font-family: Arial; ">IP:PORT要换成真实地址和port</span>
            HttpReq.Open "Get", "http:// IP:Port/invoke/path/" & LTrim(mail), False
            '以下的验证属性參数pppppppp1,2换成真实的属性值
            HttpReq.setRequestHeader "Authenticate", "pppppppp1"
            HttpReq.setRequestHeader "Version", "pppppppp2"
            
            HttpReq.send
            'MsgBox HttpReq.getAllResponseHeaders
            'MsgBox HttpReq.responseText
            
            kk = get_trace(HttpReq.responseText)
            Cells(i, 2) = tt
            Sheets("查询结果").Cells(row1, 1) = mail
            For k = 1 To kk
                Sheets("查询结果").Cells(row1, 2) = stime(k)
                Sheets("查询结果").Cells(row1, 3) = saddr(k)
                Sheets("查询结果").Cells(row1, 4) = state(k)
                row1 = row1 + 1
            Next k
            If CInt((lineno - i) / 10) * 10 = lineno - i Then
                Application.StatusBar = "剩余邮件数:" & lineno - i
            End If
        
        Next i
        
        Sheets("查询结果").Activate
        msg = MsgBox("邮件批量查询完成,共查询" & i - 3 & "个邮件!", vbOKOnly, "AHEMS:iamlaosong")
    
    End Sub
    '函数,从字符串中取出轨迹信息,返回条数
    Function get_trace(mystring As String) As Integer
        Dim m1, m2, m3, m4, n, sn As Integer
        Dim buf As String
        
        buf = mystring
        sn = 1
        tt = "0"
        For n = 1 To 80
            m1 = InStr(sn, buf, "acceptTime", vbTextCompare)
            If m1 = 0 Then Exit For
            m2 = InStr(sn, buf, "acceptAddress", vbTextCompare)
            m3 = InStr(sn, buf, "remark", vbTextCompare)
            m4 = InStr(sn, buf, "}", vbTextCompare)
            stime(n) = Mid(buf, m1 + 13, 20)
            saddr(n) = Mid(buf, m2 + 16, m3 - m2 - 19)
            state(n) = Mid(buf, m3 + 9, m4 - m3 - 10)
            sn = m4 + 2
        Next n
        
        If state(n - 1) = "妥投" Then tt = "1"
        get_trace = n - 1
    End Function
    
    


    
    
    
  • 相关阅读:
    主键、外键
    框架学习八:Model查询
    框架学习七:自动验证、填充、字段映射
    框架学习六:ORM方式添加数据
    11.0 C++远征:对象指针
    10.0 C++远征:深拷贝与浅拷贝
    9.0 C++远征:对象成员
    8.0 C++远征:对象数组
    7.0 C++远征:封装小结
    2.0 C++远征:类内定义与内联函数
  • 原文地址:https://www.cnblogs.com/mengfanrong/p/3891888.html
Copyright © 2011-2022 走看看