Dim loaddate As String, pr As String, pv As String, uv As String, newvisitor_percent As String, collection As String
Dim article As String, outside_chain As String, semshow As String, semclick As String, semconsume As String
Dim splitnull As String, semflow As String, semorders As String, semrate As String, seoflow As String, seoorders As String
Dim seorate As String, samllroutineflow As String, samllroutineorders As String, samllroutinerate As String, otherflow As String
Dim otherorders As String, otherrate As String, bak1 As String, bak2 As String, bak3 As String, bak4 As String, bak5 As String, bak6 As String
Dim oConn As New ADODB.Connection '定义mysql数据源（需要先在本地安装驱动及创建好数据源）
'******************************************************************************************************************************
'*程序名称：流量日报表自动作成
'*作 者：liuxiangtao
'*发布版本：Ver1.0
'*发布日期：2019-11-23 初版作成
'*函数构成：1、主函数：Getreport
'2、接口数据获取函数：GetDatafromapi
'3、DB数据获取函数：getDatafromdb
'4、数据沉淀函数：Putdata
'*数据来源：百度统计、百度推广、matomo
'*主要约束：1、权重、收录量无官方API；
'2、文章数、外链数依赖人工；
'3、SEO及SEM流量数据查询的是总量，日报以天为单位查询需要反复调接口，效率不高
'4、日报模板必须固定，若有调整需要调整程序
'*主要逻辑：创建数据沉淀表，根据用户查询日期和已沉淀的数据日期进行比较，若已沉淀，则直接生成结果
'否则先进行沉淀，沉淀过程分别从百度统计、百度推广和matomo获取数据，此过程最多调用两次百度api接口，解决效率问题
'******************************************************************************************************************************
Sub Getreport()
Form_date1.Hide
Dim Dstart_date As String, Dend_date As String, maxdate As String
'yyyymmdd格式的日期
Dstart_date = Form_date1.ComboBox1.Value & Form_date1.ComboBox2.Value & Form_date1.ComboBox3.Value
Dend_date = Form_date1.ComboBox6.Value & Form_date1.ComboBox5.Value & Form_date1.ComboBox4.Value
'yyyy/mm/dd格式的日期
DDstart_date = Form_date1.ComboBox1.Value & "/" & Form_date1.ComboBox2.Value & "/" & Form_date1.ComboBox3.Value
DDend_date = Form_date1.ComboBox6.Value & "/" & Form_date1.ComboBox5.Value & "/" & Form_date1.ComboBox4.Value
maxdate = ""
'模板检查
If Cells(1, 1).Value <> "推广数据统计" Or Cells(1, 13).Value <> "效果数据" Or Cells(3, 2).Value <> "权重" Or Cells(3, 9).Value <> "展现" Or Cells(3, 13).Value <> "流量" Then
MsgBox ("请打开每日报表的模板或请确认报表模板是否有调整")
Exit Sub
Else
'清空数据
Range("A4:X400").ClearContents
'禁止刷新，提升速度
Application.ScreenUpdating = False
'转化率列的格式化（百分比）
Range("O4:O400").NumberFormatLocal = "0.00%"
Range("R4:R400").NumberFormatLocal = "0.00%"
Range("U4:U400").NumberFormatLocal = "0.00%"
'连接mysql数据库
oConn.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=rm-bp179ar5909n2w4qjpo.mysql.rds.aliyuncs.com;PORT=3306;DB=matomo;UID=report;PWD=Aa111111$$;OPTION=3;"
oConn.Open
'判断是否能够正常连接数据库
If oConn.State <> 1 Then
Set oConn = Nothing
MsgBox "数据库联接失败！"
Exit Sub
End If
'定义sql语句变量
Dim strSQL As String, selectDateSQL As String
'从matomo数据库获数据的sql
strSQL = ""
strSQL = "SELECT loaddate, pr, CONVERT (pv, signed), CONVERT (uv, signed), CONVERT (newvisitor_percent, decimal(18,2)), collection, "
strSQL = strSQL & " article, outside_chain, convert (semshow, signed), convert (semclick, signed), CONVERT (semconsume, decimal(18,5)),"
strSQL = strSQL & " split, CONVERT (semflow, signed), CONVERT (semorders, signed), CONVERT (semrate, decimal(18,5)), CONVERT (seoflow, signed),"
strSQL = strSQL & " CONVERT (seoorders, signed), CONVERT (seorate, decimal(18,5)), CONVERT (samllroutineflow, signed), CONVERT (samllroutineorders, signed),"
strSQL = strSQL & " CONVERT (samllroutinerate, decimal(18,5)),CONVERT (otherflow, signed),CONVERT (otherorders, signed),CONVERT (otherrate,decimal(18,5))"
strSQL = strSQL & " FROM ma_product_everyday_report WHERE loaddate >= '" & DDstart_date & "' and " & " loaddate <= '" & DDend_date & "' order by loaddate desc"
'matomo沉淀数据的最新日期
selectDateSQL = ""
selectDateSQL = "select date_format(max(loaddate),'%Y/%m/%d') from ma_product_everyday_report"
'Cells(30, 1).Value = strSQL
'定义数据源执行结果对象
Dim rstMain As ADODB.Recordset, rstMain_1 As ADODB.Recordset
Set rstMain = New ADODB.Recordset
'执行sql获取沉淀数据的最新日期
rstMain.Open selectDateSQL, oConn, 3, 3
'将查询的最新日期存起来
maxdate = rstMain.Fields.Item(0)
'通过和用户输入的查询日期比较，判断是从百度API取数据还是从DB直接取数据
If DateDiff("d", DDend_date, maxdate) >= 0 Then '想查询的数据都在数据库里
'
Else '沉淀的数据不满足用户的需要
Dim insDate As String, putsum As Integer
putsum = 0
'看看还差多少数据没沉淀
For k = 1 To DateDiff("d", maxdate, DDend_date)
'待沉淀数据的日期
insDate = CDate(maxdate) + k
'调用数据沉淀函数
Call Putdata(insDate)
Call ShowPercentMsg("第" & k & "条数据沉淀中")
putsum = putsum + 1
Next k
End If
Set rstMain_1 = New ADODB.Recordset
rstMain_1.Open strSQL, oConn, 3, 3
Range("A4").CopyFromRecordset rstMain_1
'关闭数据库连接
rstMain.Close: Set rstMain = Nothing
rstMain_1.Close: Set rstMain_1 = Nothing
End If
oConn.Close: Set oConn = Nothing
Application.ScreenUpdating = True
MsgBox ("It's ok，本次共沉淀" & putsum & "条数据")
End Sub
'从百度api抽取数据并沉淀到本地数据库
'参数：待沉淀数据的日期
Function Putdata(Put_date As String)
'通过api获取数据一部分沉淀数据
Call GetDatafromapi(Put_date, Put_date)
'通过matomo获取一部分沉淀数据
Call getDatafromdb(Put_date, Put_date)
loaddate = Left(Put_date, 4) & "/" & Mid(Put_date, 5, 2) & "/" & Right(Put_date, 2) '沉淀数据_日期
pr = "" 'PR
collection = "" '收录量
article = "" '文章量
outside_chain = "" '外链量
splitnull = "" '分格列（无意义）
semrate = FormatNumber(semorders / semflow, 5, -1) 'SEM转化率
seorate = FormatNumber(seoorders / seoflow, 5, -1) 'SEO转化率
samllroutinerate = FormatNumber(samllroutineorders / samllroutineflow, 5, -1) '小程序转化率
otherrate = FormatNumber(otherorders / otherflow, 5, -1) '快排转化率
'以下为备用字段
bak1 = ""
bak2 = ""
bak3 = ""
bak4 = ""
bak5 = ""
bak6 = ""
'定义sql语句变量
Dim insSQL As String
'初始化
insSQL = ""
insarr = Array(loaddate, pr, pv, uv, newvisitor_percent, collection, article, outside_chain, semshow, semclick, semconsume, splitnull, semflow, semorders, semrate, seoflow, seoorders, seorate, samllroutineflow, samllroutineorders, samllroutinerate, otherflow, otherorders, otherrate, bak1, bak2, bak3, bak4, bak5, bak6)
insSQL = "INSERT INTO ma_product_everyday_report (loaddate,pr,pv,uv,newvisitor_percent,collection,article,outside_chain,semshow,semclick,semconsume,split,semflow,semorders,semrate,seoflow,seoorders,seorate,samllroutineflow,samllroutineorders,samllroutinerate,otherflow,otherorders,otherrate,bak1,bak2,bak3,bak4,bak5,bak6) VALUES "
insSQL = insSQL & "('" & Join(insarr, "','") & "')"
'定义数据源执行结果对象
Dim INSRecords As ADODB.Recordset
Set INSRecords = New ADODB.Recordset
'执行sql获取结果，adLockOptimistic表示执行过程中，数据可以正常操作
Set INSRecords = oConn.Execute(insSQL)
End Function
'通过api获取数据
'参数：起止日期
Function GetDatafromapi(SDate As String, EDate As String)
Dim Dstart_date As String, Dend_date As String
'共通header信息
SentUrl = "https://api.baidu.com/json/tongji/v1/ReportService/getData"
DuserName = "username"
Dpassword = "passwd"
Dtoken = "xxxxxxxxxxxxxxxxxx"
Daccount_type = 1
'共通body信息
Dsite_id = "12718727,12718732"
Dstart_date = SDate
Dend_date = EDate
'网站整体的body信息
Dmetrics = "pv_count,visitor_count,new_visitor_ratio"
Dmethod = "trend/time/a"
Dgran = "day"
Darea = ""
'SEO的body信息
SEODmetrics = "visitor_count"
SEODmethod = "source/engine/a"
SEODarea = ""
'SEM的body信息
SEMDmetrics = "show_count,clk_count,cost_count,visitor_count"
SEMDmethod = "pro/product/a"
SEMDarea = ""
'初始化
Return_Data = ""
SEOReturnData = ""
SEMReturnData = ""
Dim tempDB()
'共通post header（Json格式）
post_header = "{" & Chr(34) & "header" & Chr(34) & ":{" & Chr(34) & "username" & Chr(34) & ":" & Chr(34) & DuserName & Chr(34) & "," & Chr(34) & "password" & Chr(34) & ":" _
& Chr(34) & Dpassword & Chr(34) & "," & Chr(34) & "token" & Chr(34) & ":" & Chr(34) & Dtoken & Chr(34) & "," & Chr(34) & "account_type" & Chr(34) & ":1}"
'网站整体post body（Json格式）
post_body = Chr(34) & "body" & Chr(34) & ":{" & Chr(34) & "site_id" & Chr(34) & ":" & Chr(34) & Dsite_id & Chr(34) & "," & Chr(34) & "start_date" & Chr(34) & ":" _
& Chr(34) & Dstart_date & Chr(34) & "," & Chr(34) & "end_date" & Chr(34) & ":" & Chr(34) & Dend_date & Chr(34) & "," & Chr(34) & "metrics" & Chr(34) & ":" _
& Chr(34) & Dmetrics & Chr(34) & "," & Chr(34) & "method" & Chr(34) & ":" & Chr(34) & Dmethod & Chr(34) & "," & Chr(34) & "gran" & Chr(34) & ":" _
& Chr(34) & Dgran & Chr(34) & "," & Chr(34) & "area" & Chr(34) & ":" & Chr(34) & Darea & Chr(34) & "}}"
post_data = post_header & "," & post_body
'网站总体数据抽取及输出------------------------------------------------------------------
With CreateObject("Microsoft.XMLHTTP")
.Open "post", SentUrl, False
.setrequestheader "Content-type", "application/json;charset=utf-8"
.send post_data
ReturnData = .responseText
End With
arr = split(Replace(Replace(Replace(ReturnData, "[[[", "],["), "[[", "["), "]]", "]"), "],[") '格式化json数据后存储到数组
DataSum = UBound(arr) - 5 '数组中有效数据个数包括日期和PUV
PUV_visitor = split(arr(2), ",") '拆分PV和UV值
SEODstart_date = Replace(arr(1), Chr(34), "")
SEODend_date = Replace(arr(1), Chr(34), "")
pv = PUV_visitor(0)
uv = PUV_visitor(1)
newvisitor_percent = PUV_visitor(2)
Call ShowPercentMsg("API获取数据中")
'SEO及SEM数据抽取及输出------------------------------------------------------------------
SEO_post_body = Chr(34) & "body" & Chr(34) & ":{" & Chr(34) & "site_id" & Chr(34) & ":" & Chr(34) & Dsite_id & Chr(34) & "," & Chr(34) & "start_date" & Chr(34) & ":" _
& Chr(34) & SEODstart_date & Chr(34) & "," & Chr(34) & "end_date" & Chr(34) & ":" & Chr(34) & SEODend_date & Chr(34) & "," & Chr(34) & "metrics" & Chr(34) & ":" _
& Chr(34) & SEODmetrics & Chr(34) & "," & Chr(34) & "method" & Chr(34) & ":" & Chr(34) & SEODmethod & Chr(34) & "," & Chr(34) & "area" & Chr(34) & ":" _
& Chr(34) & SEODarea & Chr(34) & "}}"
SEM_post_body = Chr(34) & "body" & Chr(34) & ":{" & Chr(34) & "site_id" & Chr(34) & ":" & Chr(34) & Dsite_id & Chr(34) & "," & Chr(34) & "start_date" & Chr(34) & ":" _
& Chr(34) & SEODstart_date & Chr(34) & "," & Chr(34) & "end_date" & Chr(34) & ":" & Chr(34) & SEODend_date & Chr(34) & "," & Chr(34) & "metrics" & Chr(34) & ":" _
& Chr(34) & SEMDmetrics & Chr(34) & "," & Chr(34) & "method" & Chr(34) & ":" & Chr(34) & SEMDmethod & Chr(34) & "," & Chr(34) & "area" & Chr(34) & ":" _
& Chr(34) & SEMDarea & Chr(34) & "}}"
seo_post_data = post_header & "," & SEO_post_body
sem_post_data = post_header & "," & SEM_post_body
'SEO数据处理及输出
With CreateObject("Microsoft.XMLHTTP")
.Open "post", SentUrl, False
.setrequestheader "Content-type", "application/json;charset=utf-8"
.send seo_post_data
SEOReturnData = .responseText
End With
SEOarr = split(Replace(Replace(Replace(SEOReturnData, "[[[", "],["), "[[", "["), "]]", "]"), "],[") '格式化json数据后存储到数组
SEOsum = split(SEOarr(UBound(SEOarr) - 3), ":[")
seoflow = Replace(SEOsum(2), Chr(34), "")
'SEM数据处理及输出
With CreateObject("Microsoft.XMLHTTP")
.Open "post", SentUrl, False
.setrequestheader "Content-type", "application/json;charset=utf-8"
.send sem_post_data
SEMReturnData = .responseText
End With
SEMarr = split(Replace(Replace(Replace(SEMReturnData, "[[[", "],["), "[[", "["), "]]", "]"), "],[") '格式化json数据后存储到数组
SEMsum = split(SEMarr(4), ":[")
SEM = split(Replace(SEMsum(2), Chr(34), ""), ",")
semshow = SEM(0)
semclick = SEM(1)
semconsume = SEM(2)
semflow = SEM(3)
'Call getDatafromdb(Dstart_date, Dend_date)
End Function
'matomo中查询SEO和SEM的订单数
'参数：日期区间
Function getDatafromdb(StartDate As String, EndDate As String)
StartDate = Replace(StartDate, "/", "")
EndDate = Replace(EndDate, "/", "")
'定义sql语句变量
Dim strSQL1 As String, strSQL3 As String
'初始化
strSQL1 = ""
strSQL3 = ""
'待执行sql语句
'SEM、SEO、小程序、快排订单
strSQL1 = "SELECT sum(case when right(b.referer_name,2) in('pc','yd') then 1 else 0 end) ,sum(case when (b.referer_type = '2' or b.referer_name in ('m.baidu.com','www.baidu.com','www.so.com','m.so.com','www.sogou.com','m.sogou.com','www.google.com','m.google.com','yz.m.sm.cn','m.sm.cn')) then 1 else 0 end),"
strSQL1 = strSQL1 & " sum(case when b.campaign_source in ('xiaochengxu','小程序') then 1 else 0 end), sum(case when b.idsite in ('11','14') then 1 else 0 end)"
strSQL1 = strSQL1 & " FROM ma_log_conversion_item a, ma_log_conversion b WHERE a.idorder = b.idorder"
strSQL1 = strSQL1 & " AND DATE_FORMAT(DATE_ADD(a.server_time,INTERVAL 8 HOUR),'%Y%m%d') >= '" & StartDate & "'"
strSQL1 = strSQL1 & " AND DATE_FORMAT(DATE_ADD(a.server_time,INTERVAL 8 HOUR),'%Y%m%d') <= '" & EndDate & "'"
strSQL1 = strSQL1 & " group by DATE_FORMAT(DATE_ADD(a.server_time,INTERVAL 8 HOUR),'%Y%m%d') order by a.server_time desc"
'小程序流量&快排流量
strSQL3 = "SELECT sum(IF((campaign_source IN ('xiaochengxu', '小程序')),1,0)),sum(IF((idsite IN ('11', '14')),1,0)) FROM ma_log_visit WHERE"
strSQL3 = strSQL3 & " DATE_FORMAT(DATE_ADD(visit_last_action_time,INTERVAL 8 HOUR),'%Y%m%d') >='" & StartDate & "'"
strSQL3 = strSQL3 & " AND DATE_FORMAT(DATE_ADD(visit_last_action_time,INTERVAL 8 HOUR),'%Y%m%d') <='" & EndDate & "'"
strSQL3 = strSQL3 & " GROUP BY DATE_FORMAT(DATE_ADD(visit_last_action_time,INTERVAL 8 HOUR),'%Y%m%d') ORDER BY visit_last_action_time DESC"
Call ShowPercentMsg("Matomo获取数据中")
'定义数据源执行结果对象
Dim rstMain1 As ADODB.Recordset, rstMain3 As ADODB.Recordset
'存储SEM、SEO、小程序、快排订单数据
Set rstMain1 = New ADODB.Recordset
rstMain1.Open strSQL1, oConn, 3, 3
orderarr = rstMain1.GetRows
'小程序流量&快排流量数据
Set rstMain3 = New ADODB.Recordset
rstMain3.Open strSQL3, oConn, 3, 3
visitarr = rstMain3.GetRows
'数据剥离
semorders = orderarr(0, 0)
seoorders = orderarr(1, 0)
samllroutineorders = orderarr(2, 0)
otherorders = orderarr(3, 0)
samllroutineflow = visitarr(0, 0)
otherflow = visitarr(1, 0)
'关闭释放
rstMain1.Close: Set rstMain1 = Nothing
rstMain3.Close: Set rstMain3 = Nothing
End Function
©️公众号：思考者文刀
- 上一篇： svn merge命令合包脚本（按日期）
- 下一篇： 7步打造强大的个人品牌
评论