Excel批量获取手机归属地

柠檬十三

API示例：https://tcc.taobao.com/cc/json/m ... htm?tel=13350385828
参考文章：https://zhidao.baidu.com/question/391812068022544365.html


需求：在Excel中可以批量获取手机归属地，可用VBA或函数公式

3+1=2+2

1. Option Explicit
   
2. 
   
3. Public Function GetInfo(strnum As String)
   
4.     Dim xmlhttp As Object
   
5.     Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
   
6.     xmlhttp.Open "get", "http://www.tiantianxieye.com/nub/" & strnum & ".html", False
   
7.     xmlhttp.setRequestHeader "If-Modified-Since", "0"
   
8.     xmlhttp.send
   
9.    
   
10.     Do While xmlhttp.readystate <> 4
    
11.         DoEvents
    
12.     Loop
    
13.    
    
14.     Dim strResult As String
    
15.     strResult = StrConv(xmlhttp.responseBody, vbUnicode)
    
16.    
    
17.     Dim RegEx As Object
    
18.     Set RegEx = CreateObject("VBScript.RegExp")
    
19.     Dim match As Object
    
20.    
    
21.    
    
22.     RegEx.Global = True
    
23.     RegEx.ignorecase = True
    
24.     RegEx.Pattern = "卡号归属地：</SPAN><SPAN class=T>(.+?)</SPAN>[\s\S]+?卡号类型[\s\S]+?class=T>(.+?)</"
    
25.    
    
26.     If RegEx.Test(strResult) Then
    
27.         
    
28.         Dim matchs As Object
    
29.         Set matchs = RegEx.Execute(strResult)
    
30.         
    
31.         Dim arr(1 To 2)
    
32.         
    
33.         For Each match In matchs
    
34.             arr(1) = match.submatches(0)
    
35.             arr(2) = match.submatches(1)
    
36.         Next
    
37.     End If
    
38.     Debug.Print arr(1), arr(2)
    
39. End Function
    

复制代码

3+1=2+2

参数为手机号，注意是字符串类型

柠檬十三

3+1=2+2 发表于 2020-11-22 01:53

是插入模块使用吗？