Sub QQ群信息()
Dim Grade,d As Object, i&, Url$, strText$, Cnt&, MystrText, arr()
On Error Resume Next
Application.ScreenUpdating = False
Grade = [{"1","试用";"2","专员";"3","主管";"4","经理";"5","总监";"6","董事"}]
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Grade)
d(Grade(i, 1)) = Grade(i, 2)
Next i
Url = "" '从fidder中获取QQ群地址
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", Url, False
.setRequestHeader "Cookie","" '从fidder中获取防盗链
.send
strText = .responsetext
End With
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
strText = Replace(Split(strText, "members")(1), "{", "},", 1, 1)
Cnt = (Len(strText) - Len(Replace(strText, "jt", ""))) / 2
ReDim arr(1 To Cnt, 1 To 8)
For i = 1 To Cnt
MystrText = Split(Split(strText, "},""")(i), "}")
arr(i, 1) = Split(MystrText(0), """:")(0)
arr(i, 2) = Split(Split(MystrText(0), "cd"":""")(1), """,")(0)
arr(i, 3) = DateAdd("s", Split(Split(MystrText(0), "jt"":")(1), ",")(0), "01/01/1970 08:00:00")
arr(i, 4) = Split(Split(MystrText(0), "lad"":")(1), ",")(0)
arr(i, 5) = d(Split(Split(MystrText(0), "ll"":")(1), ",")(0))
arr(i, 6) = Split(Split(MystrText(0), "lp"":")(1), ",")(0)
arr(i, 7) = DateAdd("s", Split(Split(MystrText(0), "lst"":")(1), ",")(0), "01/01/1970 08:00:00")
arr(i, 8) = Split(Split(MystrText(0), "nk"":""")(1), """")(0)
Next i
[a1:h1] = [{"QQ号","群名片","入群时间","Lad","等级","积分","最后一次发言时间","昵称"}]
[a2].Resize(UBound(arr), UBound(arr, 2)) = arr
Application.ScreenUpdating = True
Set d = Nothing
End Sub