想将红色部分标注在箭头位置,下面两个代码怎么修正呢?
此主题相关图片如下:6a8f.tm.png
代码一:(按钮事件代码里)'DataTables("图文群发每日数据").DataRows.Clear
If Forms("主窗体").opened=True Then
Dim ab As Date =DataTables("微信图文素材列表").compute("Max(更新时间)")
Dim abc As Date ="2014-12-01"
Dim t As TimeSpan = ab - abc
Dim dr As DataRow
'Tables("微信图文素材列表").StopRedraw
Try
For i As Integer = 0 To t.Days
Dim str As Date = abc.AddDays(i)
Dim fdr As DataRow = DataTables("图文群发每日数据").Find("操作日期 = '" & Format(str, "yyy-MM-dd") & "'")
If fdr IsNot Nothing Then
Continue For
End If
dr = DataTables("图文群发每日数据").AddNew()
dr("操作日期") = Format(str, "yyy-MM-dd")
dr("单位")= Forms("主窗体").Controls("Treeview1").SelectedNode.ParentNode.Name
Next
Catch
Finally
'Tables("图文群发每日数据").ResumeRedraw
End Try
End If
代码二:(表列改变事件里)
'...
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
'MessageBox.Show(json)
Dim haserror As Boolean
If jsonString.Contains("errcode") Then
Output.Logs("错误日志").Add(User.Name & ":" & Date.Now & vbcrlf & jsonString)
Output.Logs("错误日志").Save("c:\log.txt",True)
Output.Logs("错误日志").Clear
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