VBA implements mail Track query through HTTP protocol

Iamlasong

1. Interface Description

For Internet access, the interface call is an HTTP request. For each HTTP request initiated by a user, authentication information must be set. The specific method is to add the version and authenticate attributes in the HTTP header section, attribute values are provided by the Headquarters before joint debugging and testing.

Interface call address: http: // ip: Port/invoke/path/{mail_num}

Interface call method: http get method, initiate a request through http get, replace {mail_num} with the actual email number}

Encoding format: UTF-8

Format of the data returned by the API:

{"Traces": [{"accepttime": "2011-11-2417: 55: 00", "acceptaddress": "Shanghai Post Express logistics Changning Department", "remark ":"Receiving and sending"},{" Accepttime ":" 2011-11-2417: 59: 00 "," acceptaddress ":" Changning Department of Shanghai Post Express Logistics "," remark ": "Leave the processing center and send it to the postal express delivery Bureau of Shanghai postal company" },{ "accepttime": "2011-11-2423: 54: 38", "acceptaddress": "Shanghai ", "remark": "Arrival Processing Center, from Shanghai Post Express logistics Changning Operations Department" },{ "accepttime": "2011-11-2500: 17: 42", "acceptaddress ": "Shanghai City", "remark": "Exit Processing Center, send to ussfof" },{ "accepttime": "2011-12-0507: 41: 00", "acceptaddress ": "US 94704", "remark": "arrival to delivery board" },{ "accepttime": "2011-12-0511: 07: 00", "acceptaddress ": "US 94703", "remark ":"Totou"}]}

Accepttime indicates the processing time.

Acceptaddress indicates the processing location

Remark indicates the processing action

2. query interface

3. query results

4. Program Implementation

<PRE name = "code" class = "VB"> dim TT, stime (80), saddr (80), State (80) as stringpublic sub get_data () 'dim httpreq as object dim I, K, KK, row1 as integer lineno = [a65536]. end (xlup ). row 'row range ("B2: B" & lineno ). clearcontents 'lineno = activesheet. usedrange. rows. count set httpreq = Createobject ("msxml2.xmlhttp. 3.0 ") row1 = 2 maxrow = sheets (" query result "). usedrange. rows. count if maxrow> = 2 then sheets ("query Query Result "). 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; "> replace IP: port with the actual address and port </span> httpreq. open "get", "http: // ip: Port/invoke/path/" & ltrim (mail), false' verification attribute parameter pppppppp1, 2. Change the value to httpreq. setRequestHeader "authenticate", "pppppp1" httpreq. setRequestHeader "version", "pppppppp2" httpreq. send 'msg Box httpreq. getAllResponseHeaders 'msgbox httpreq. responsetext KK = get_trace (httpreq. responsetext) cells (I, 2) = TT sheets ("query result "). cells (row1, 1) = Mail for k = 1 to KK sheets ("query result "). cells (row1, 2) = stime (k) sheets ("query result "). cells (row1, 3) = saddr (k) sheets ("query result "). cells (row1, 4) = State (k) row1 = row1 + 1 next K if CINT (lineno-I)/10) * 10 = lineno-I then application. statusbar = "remaining mails :"& Lineno-I end if next I sheets ("query result"). Activate MSG = msgbox ("batch query is completed, total query" & I-3 & "emails! ", Vbokonly," ahems: iamlaosong ") end sub 'function, extracts the trajectory information from the string, and returns the number of 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) = "tocast" then TT = "1" get_trace = N-1end Function