今天小雅问小采一个问题，怎样批量查询采集手机号码归属地？
小采的第一想法是用火车采集器啊，无需复杂编程即可轻松采集。
然而小雅鸡贼的加了个限制，不准用火车头，emmm，这下有点麻烦了，除了火车头还有什么别的办法可以查询呢？
1
今天小采就教大家一个简单实用的小技巧。
❶首先，我们用随机函数，生成一批手机号码，在Excel中模拟，使用函数=RANDBETWEEN(13000000000,13999999999)，生成了一批手机号码，如下所示：
❷如果我们一个个查询，只能去网站上面输入手机号，然后得到相应的结果。我们记住网站，然后后面用函数进行抓取。
❸我们首先建议一个辅助列，得到查询这个手机号的网页链接地址，在B2输入公式：="https://shouji.51240.com/"&A2&"__shouji/"，批量得到链接地址，如下所示：
然后再使用函数，从网页中抓取数据，并剔除一些没有用的字符串，大家可以看下面截图中的公式使用，如下所示：
便可以得到是哪个运营商，以及该手机号码对应的省份和城市。
如果不理解公式的话，就直接按照上面的步骤操作就好了。这个功能要联网才能实现，在Excel打开的时候，要点击允许连接网络。
2
或者还有一种方法，那就是自己来写代码。首先你要找好几个webapi，然后就用vba写自定义函数，测试下运行还是很正常的。
使用方法具体如下：
1.在本表中直接在A1列输入手机号即可
2.要在其他表中，alt+f11打开vbe编辑器，复制模块中代码,在你的新表中建立模块，粘贴代码即可
3.函数参数说明
GetPhoneInfo(号码,参数)
号码—即单个手机号
参数（1,2,3,4）：1-城市，2-省，3-运营商, 4-全部
部分代码如下：
Function GetPhoneInfo(number, Optional para As Byte = 1)
'获取手机号对应的基本信息 默认为城市
'para:1-城市，2-省，3-运营商,4,全部
Dim s As String
s = GetBody("http://v.showji.com/Locating/showji.com2016234999234.aspx?
output=json&callback=querycallback&m=" & number)
Select Case para
Case 1
GetPhoneInfo = HtmlFilter(s, "City"":""", """")
Case 2
GetPhoneInfo = HtmlFilter(s, "Province"":""", """")
Case 3
GetPhoneInfo = HtmlFilter(s, "TO"":""", """")
Case 4
GetPhoneInfo = HtmlFilter(s, "City"":""", """") & "," &
HtmlFilter(s, "Province"":""", """") & "," & HtmlFilter(s, "TO"":""", """")
End Select
GetPhoneInfo = Replace(GetPhoneInfo, " ", "")
End Function
Private Sub Test()
Dim i&, j&, k&, arr, brr
url = "http://v.showji.com/Locating/showji.com2016234999234.aspx?
output=json&callback=querycallback&m=15098051755"
Debug.Print GetBody(url)
End Sub
'''如果出现乱码，UTF-8可改为GB2312
Public Function GetBody(ByVal url$, Optional ByVal Coding$ = "utf-8")
On Error Resume Next
Set 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"
.Send
GetBody = .ResponseBody
End With
GetBody = BytesToBstr(GetBody, Coding)
Set ObjXML = Nothing
End Function
Public Function BytesToBstr(strBody, CodeBase)
Dim ObjStream
Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
.Type = 1: .Mode = 3: .Open:
.Write strBody: .Position = 0: .Type = 2: .Charset = CodeBase
BytesToBstr = .ReadText: .Close
End With
Set ObjStream = Nothing
End Function
Public Function HtmlFilter(ByVal htmlText$, ByVal Label1$, ByVal label2$)
'返回html字符串lable1和最近的lable2标签中的数据
Dim pStart As Long, pStop As Long
pStart = InStr(htmlText, Label1) + Len(Label1)
If pStart <> 0 Then
pStop = InStr(pStart, htmlText, label2)
HtmlFilter = Mid(htmlText, pStart, pStop - pStart)
End If
End Function
3
本周的每周一数小采为大家带来的就是28万手机号码归属地数据。
活动领取资格：火车采集器/火车浏览器商业版（服务年限内）用户。领取时间：发文后5个工作日内（周末工作人员休息）。值得注意的一点是，如果不是服务年限内的商业版用户就无法领取赠送数据哦！
赠送数据字段名：包含ID，手机号，区域，城市，移动运营商，区号，邮编共7个字段名。
赠送数据领取时间：2019年3月15日发文后5个工作日内。
赠送数据领取方式：
第一步：扫码添加火车运营微信，运营会第一时间拉你进福利分享群，赶快来和商业用户的大神们一起畅聊吧。
第二步：进群后加数据咨询客服.雅的微信号，验证是否服务年限内商业用户，通过验证后即可领取今日头条大数据。
如果你还知晓更多采集查询手机号归属地的方法，也可以在公众号下方留言分享哦。
