分享：json解析操作分享，感谢有点蓝等老师，希望对大家操作有所参考帮助。 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

Javascript是大小写敏感的，要关闭代码编辑器的着色功能

'...

Dim postdata As String ="{""type"":""news"",""offset"":""0"",""count"":""2000""}"

Dim url = String.Format("https://api.weixin.qq.com/cgi-bin/material/batchget_material?access_token=CQC8IZ77bPftBxnEovxmIbhx3EQ7PdSzDXaPl2ag9W5ky6l3Cis8camkkZVOuvJxurMjfXJH3hALFXBxfQLJiBiFlEJA8-r7hRpBqsIIEitSSORhf22AtVZMBk1oUkGeGWKfAIASIW")

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 dr As DataRow

For Each obj As object In data.item

For Each item As object In obj.content.news_item

dr = DataTables("表A").AddNew

dr("第六列") = obj.media_id

Dim BaseDatetime As New DateTime(1970, 1, 1)

'Output.Show(BaseDatetime.AddSeconds(1476065493).AddHours(8))

dr("第二列") = BaseDatetime.AddSeconds(obj.update_time).AddHours(8)

dr("第一列") = item.title

dr("第三列") = item.url

dr("第四列") = item.content_source_url

dr("第五列") = item.author

End Using

[此贴子已经被作者于2016/11/4 1:40:27编辑过]

有点色老师，顶楼操作虽然可以实现想要获取的数据，但是如果接口不对，密钥不对，接口操作操作限制次数，均会报如下错误：

格式如下：

{"errcode":45009,"errmsg":"reach max api daily quota limit hint: [.bOt70356e562]"}

然后会有一个错误弹出框出现，提示错误，因为没有得到json文件，所以就不会有list公共内容部分，老弹出来严重影响操作，

有没有办法增加一个判断代码呢？

正常情况下，获取图文群发每日数据接口的返回JSON数据包如下：

{ 
    "list": [ 
        { 
            "ref_date": "2014-12-08", 
            "msgid": "10000050_1", 
            "title": "12月27日 DiLi日报", 
            "int_page_read_user": 23676, 
            "int_page_read_count": 25615, 
            "ori_page_read_user": 29, 
            "ori_page_read_count": 34, 
            "share_user": 122, 
            "share_count": 994, 
            "add_to_fav_user": 1, 
            "add_to_fav_count": 3
        } 
 	 //后续会列出该日期内所有被阅读过的文章（仅包括群发的文章）在当天的阅读次数等数据
    ]
}

如果返回的josn内容有errcode部分，就直接取消写表操作，弹出“45009，接口操作次数”的提示！

如果返回的JOSN内容有list部分，就进行写表操作。

有没有办法只让这个运行一次呢？

当表增加一行的时候就提示一次多行就提示了多次

我想实现同样的错误该代码只运行一次

经测试居然还是一样每行都在报错

代码如下：

麻烦有点蓝老师啦

这个事件我放在表列数据发生变化的时候代码里的

'...

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

end if

End Using

End If

End Select

是采用这样的写法么？

Try
'追加数据代码
Catch ex As Exception
MessageBox.Show("追加数据失败")
End Try

Output.Logs("错误日志").Add(e.datarow("操作日期") & "在" & Date.Now & "出错了" & "errcode:49001")

是这样写么？

这个出错提示，我是想根据上面的

Dim dr1 As DataRow =DataTables("微信基础表").Find("公众号名称 = '" & Forms("主窗体").Controls("Treeview1").SelectedNode.ParentNode.Name & "'")

Dim url = String.Format("https://api.weixin.qq.com/datacube/getarticlesummary?access_token=" & dr1("ACCESSTOKEN") & "")

来判断是否可以正常获取值，如果不能获取，出现了errcode:49001错误的话，就提示该错误出来。如果是errcode:45001错误的话就提示该错误

让用户明白错误之处是出现在哪里，进而改正。

主题：分享：json解析操作分享，感谢有点蓝等老师，希望对大家操作有所参考帮助。