'...
Select Case e.DataCol.Name
Case "操作日期"
If e.NewValue IsNot Nothing Then
Dim str As String=Format(e.NewValue , "yyy-MM-dd")
'MessageBox.Show(str)
Dim postdata As String ="{""begin_date"": """ & str & """, ""end_date"": """ & str & """ }"
'MessageBox.Show(postdata)
Dim dr1 As DataRow =DataTables("微信基础表").Find("公众号名称 = '" & Forms("主窗体").Controls("Treeview1").SelectedNode.ParentNode.Name & "'")
'MessageBox.Show("公众号名称 = '" & Forms("主窗体").Controls("Treeview1").SelectedNode.ParentNode.Name & "'")
Dim url = String.Format("https://api.weixin.qq.com/datacube/getarticlesummary?access_token=" & dr1("ACCESSTOKEN") & "")
'MessageBox.Show(url)
Using ms As New System.IO.MemoryStream()
Dim bytes = ConvertHelper.EncodingToBytes(postdata, System.Text.Encoding.UTF8)
ms.Write(bytes, 0, bytes.Length)
ms.Seek(0, System.IO.SeekOrigin.Begin)
Dim jsonString = Functions.Execute("HttpPost",url, ms) '通过POST向接口传输菜单数据,并取得返回结果
Dim json As String = jsonString
Dim ScriptControl As Object, data As Object, JscriptCode As String
JscriptCode = "function toObject(json) {eval(""var o=""+json);return o;}"
ScriptControl = CreateObject("MSScriptControl.ScriptControl")
With ScriptControl
.Language = "Javascript"
.Timeout = -1
.AddCode(JscriptCode)
data = .Run("toObject", json)
End With
output.Show(json)
Dim haserror As Boolean
If jsonString.Contains("errcode") Then
If not haserror Then
msgbox("出错")
haserror = True
End If
else
Dim dr As DataRow
For Each obj As object In data.list
dr = DataTables("图文群发每日数据").AddNew
'dr("操作日期") = obj.ref_date
dr("进入方式") = obj.user_source
dr("图文阅读人数") = obj.int_page_read_user
dr("图文阅读次数") = obj.int_page_read_count
dr("分享人数") = obj.share_user
dr("分享次数") = obj.share_count
dr("原文阅读次数") = obj.ori_page_read_user
dr("原文阅读人数") = obj.ori_page_read_count
dr("收藏人数") = obj.add_to_fav_user
dr("收藏次数") = obj.add_to_fav_count
dr("文章标题") = obj.title
dr("图文编号") = obj.msgid
Next
end if
End Using
End If
End Select
加好友 
发短信
Post By：2016/11/6 18:56:00 [只看该作者]
