此主题相关图片如下：无标题.png
老师，查过后台，这样的意思 是不是订阅号就没有办法获取得到OPENID了。
不更改为服务号的情况，有没有什么办法可以获取用户的OPENID号。
以下可以获取得到所有用记的openid,便如何知道当前用户的OPENID？
DataTables("WXUsers").DataRows.Clear()
Dim ul As String = "https://api.weixin.qq.com/cgi-bin/user/get?access_token={0}&next_openid={1}" '获取用户OpenID列表接口
Dim il = "https://api.weixin.qq.com/cgi-bin/user/info/batchget?access_token={0}" '批量获取用户信息接口
Dim nms() As String = {"openid","nickname","sex","city","country","province","headimgurl","groupid","remark","language"} '列名
PopMessage(Functions.Execute("GetAccessToken"))
Dim hc As New HttpClient(CExp(ul, Functions.Execute("GetAccessToken"),""))
Dim ids As New List(of String) 'OpenId集合,每次获取10000个
Dim ba As New Jarray '准备用来获取用户信息的OpenId列表,一次不能超过100个
Dim jo As JObject = JObject.Parse(hc.GetData)
Do '循环获取,一次只能获取10000个OpenID
If jo("errcode") Is Nothing Then
Dim cnt As Integer = jo("count")
If cnt = 0 Then '如果已经获取完所有用户'
Exit Do
End If
For Each jk As JToken In jo("data")("openid")
ids.Add(jk)
Next
For i As Integer = 0 To ids.Count - 1 '循环获取用户详情,一次不能超过100个用户
Dim uo As New JObject
uo("openid") = ids(i)
ba.Add(uo)
If ba.Count = 100 OrElse i = ids.Count - 1 Then '每满100个就获取一次
Dim bo As New Jobject
bo("user_list") = ba
hc = New HttpClient(CExp(il, Functions.Execute("GetAccessToken")))
hc.Content = bo.ToString()
Dim ro As JObject = JObject.Parse(hc.GetData)
If ro("errcode") Is Nothing Then
Dim ia As JArray = ro("user_info_list") '获取的用户信息列表
For Each jt As JToken In ia
Dim dr As DataRow = DataTables("WXUsers").Find("openid = '" & jt("openid").ToString() & "'")
If dr Is Nothing Then
dr = DataTables("WXUsers").AddNew()
End If
For Each nm As String In nms
dr(nm) = jt(nm)
Next
dr("tagid_list") = CompressJSON(jt("tagid_list"))
Next
Else
MessageBox.Show(ro.ToString)
Exit For
End If
ba.Clear() '清除集合,准备获取下一批用户详情,每批只能100个.
End If
Next
ids.Clear '清除已经获取的OpenID.,准备接收下一批OpenID
hc = New HttpClient(CExp(ul, Functions.Execute("GetAccessToken"),jo("next_openid").Tostring)) '获取下一批OpenID
jo = JObject.Parse(hc.GetData)
Else
MessageBox.Show(jo.ToString)
Exit Do
End If
Loop
DataTables("WXUsers").Save()
[此贴子已经被作者于2019/12/2 15:16:43编辑过]
加好友 
发短信
Post By：2019/11/30 15:19:00 [显示全部帖子]
