EXCEL自定义函数获取手机号码归属地及运营商信息

有人在群里问手机号怎么批量查归属地，第一感觉是百度一下，结果还真没找到好用的，既然如此，我就自己写一个吧！首先找了几个webapi，找到这个挺好用的http://life.tenpay.com/cgi-bin/mobile/MobileQueryAttribution.cgi?chgmobile=13905221984，就用vba写了个自定义函数，测试下感觉还是挺好用，速度也挺快源文件下载链接请头条或者公众号私信回复63005即可

使用方法：1.在本表中直接在A1列输入手机号即可2.要在其他表中，alt+f11打开vbe编辑器，复制模块中代码,在你的新表中建立模块，粘贴代码即可3.函数参数说明GetPhoneInfo(号码,参数)号码—即单个手机号参数（1,2,3,4）：1-城市，2-省，3-运营商,    4-全部代码1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162Dim ObjXML As ObjectFunction GetPhoneInfo(number, Optional para As Byte = 1)'获取手机号对应的基本信息 默认为城市'para:1-城市，2-省，3-运营商,4,全部Dim s As Strings = GetBody("http://v.showji.com/Locating/showji.com2016234999234.aspx?output=json&callback=querycallback&m=" & number)Select Case paraCase 1GetPhoneInfo = HtmlFilter(s, "City"":""", """")Case 2GetPhoneInfo = HtmlFilter(s, "Province"":""", """")Case 3GetPhoneInfo = HtmlFilter(s, "TO"":""", """")Case 4GetPhoneInfo = HtmlFilter(s, "City"":""", """") & "," &HtmlFilter(s, "Province"":""", """") & "," & HtmlFilter(s, "TO"":""", """")End SelectGetPhoneInfo = Replace(GetPhoneInfo, " ", "")End FunctionPrivate Sub Test()Dim i&, j&, k&, arr, brrurl = "http://v.showji.com/Locating/showji.com2016234999234.aspx?output=json&callback=querycallback&m=15098051755"Debug.Print GetBody(url)End Sub'''如果出现乱码，UTF-8可改为GB2312Public Function GetBody(ByVal url$, Optional ByVal Coding$ = "utf-8")On Error Resume NextSet ObjXML = CreateObject("Microsoft.XMLHTTP")With ObjXML.Open "Get", url, False, "", ""'.setRequestHeader "If-Modified-Since", "0"'.setRequestHeader "User-Agent", _".Mozilla/5.0 (Windows NT 6.1; WOW64; rv:47.0) Gecko/20100101 Firefox/47.0".SendGetBody = .ResponseBodyEnd WithGetBody = BytesToBstr(GetBody, Coding)Set ObjXML = NothingEnd FunctionPublic Function BytesToBstr(strBody, CodeBase)Dim ObjStreamSet ObjStream = CreateObject("Adodb.Stream")With ObjStream.Type = 1: .Mode = 3: .Open:.Write strBody: .Position = 0: .Type = 2: .Charset = CodeBaseBytesToBstr = .ReadText: .CloseEnd WithSet ObjStream = NothingEnd FunctionPublic Function HtmlFilter(ByVal htmlText$, ByVal Label1$, ByVal label2$)'返回html字符串lable1和最近的lable2标签中的数据Dim pStart As Long, pStop As LongpStart = InStr(htmlText, Label1) + Len(Label1)If pStart <> 0 ThenpStop = InStr(pStart, htmlText, label2)HtmlFilter = Mid(htmlText, pStart, pStop - pStart)End IfEnd FunctionEXCEL880工作室为您服务,VBA,函数,网页数据抓取,数据分析,足彩,彩票分析,编程开发,office批量操作,办公自动化