今天小雅問小采一個問題，怎樣批量查詢采集手機號碼歸屬地？
小采的第一想法是用火車采集器啊，無需復雜編程即可輕松采集。
然而小雅雞賊的加了個限制，不準用火車頭，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個工作日內。
贈送數據領取方式：
第一步：掃碼添加火車運營微信，運營會第一時間拉你進福利分享群，趕快來和商業用戶的大神們一起暢聊吧。
第二步：進群后加數據咨詢客服.雅的微信號，驗證是否服務年限內商業用戶，通過驗證后即可領取今日頭條大數據。
如果你還知曉更多采集查詢手機號歸屬地的方法，也可以在公眾號下方留言分享哦。
