作为简要说明,我整理了一个脚本,以帮助将生成的CSV中的每周Google Analytics数据导入一个主工作簿。有可能会在此跟踪系统中添加更多网站帐户,因此我有另一个脚本可帮助添加帐户,以确保电子表格/表格中的所有内容都保持一致。
对于实际导入,我有一个“两部分”VBA脚本,用于遍历文件夹中的所有CSV,打开它们,将CSV中的数据导入主工作簿,然后删除CSV成功完成循环后再转到下一个循环。我已经包含一个错误声明,告诉用户他们导入的CSV是否在主工作簿中没有匹配的电子表格,以便它在那时停止脚本,让他们有机会将该帐户添加到继续之前的工作手册。
但是,有些星期特定网站可能没有所有数据,这错误地导致错误消息显示告诉用户该帐户需要添加到网站。如果CSV不包含该数据,那是因为数据基本上是0,并且我想要在行中输入0来记下那周没有活动,不要给用户一个他们需要添加的错误帐户到工作簿。
'THE FOLLOWING SCRIPT RUNS WHEN THE IMPORT ANALYTICS BUTTON IS CLICKED
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'if at any point an error is encountered, display the Error Message (at end of script)
On Error GoTo ErrMsg
'Optimize Macro Speed by turning off screen updating
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder That Contains Your Files"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.csv*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
wb.Activate
'Ensure Workbook has opened and is active before moving on to next line of code
DoEvents
Dim rng1 As Range
Dim strSearch As String
Dim sheet_name_result As String
'sets the URL (minus the "# " in front) to be the search string
strSearch = Right(ActiveWorkbook.Sheets(1).Range("A2"), Len(ActiveWorkbook.Sheets(1).Range("A2")) - 2)
'sets the data list URL column to be the searched range
Set rng1 = Workbooks("Spokes- Google Analytics trends.xlsm").Worksheets("LISTS").Range("B:B").Find(strSearch, , xlValues, xlPart)
sheet_name_result = rng1.Offset(0, -1).Value
'LOOP THROUGH FOLLOWING CODE IF A MATCH IS FOUND
If Not rng1 Is Nothing Then
Dim table_list_object As ListObject
Dim table_object_row As ListRow
Set table_list_object = Workbooks("Spokes- Google Analytics trends.xlsm").Worksheets(sheet_name_result).ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add
'calculate pageviews
Dim organic_pageviews As Integer
Dim paid_pageviews As Integer
Dim direct_pageviews As Integer
Dim referral_pageviews As Integer
Dim display_pageviews As Integer
Dim sum_pageviews As Integer
organic_pageviews = Application.SumIf(Range("A:A"), "organic", Range("C:C"))
paid_pageviews = Application.SumIf(Range("A:A"), "paid", Range("C:C"))
direct_pageviews = Application.SumIf(Range("A:A"), "direct", Range("C:C"))
referral_pageviews = Application.SumIf(Range("A:A"), "referral", Range("C:C"))
display_pageviews = Application.SumIf(Range("A:A"), "display", Range("C:C"))
sum_pageviews = organic_pageviews + paid_pageviews + direct_pageviews + referral_pageviews + display_pageviews
'calculate visitors aka sessions
Dim organic_visitors As Integer
Dim paid_visitors As Integer
Dim direct_visitors As Integer
Dim referral_visitors As Integer
Dim display_visitors As Integer
Dim sum_visitors As Integer
organic_visitors = Application.SumIf(Range("A:A"), "organic", Range("F:F"))
paid_visitors = Application.SumIf(Range("A:A"), "paid", Range("F:F"))
direct_visitors = Application.SumIf(Range("A:A"), "direct", Range("F:F"))
referral_visitors = Application.SumIf(Range("A:A"), "referral", Range("F:F"))
display_visitors = Application.SumIf(Range("A:A"), "display", Range("F:F"))
sum_visitors = organic_visitors + paid_visitors + direct_visitors + referral_visitors + display_visitors
'calculate unique visitors aka new users
Dim organic_new As Integer
Dim paid_new As Integer
Dim direct_new As Integer
Dim referral_new As Integer
Dim display_new As Integer
Dim sum_new As Integer
organic_new = Application.SumIf(Range("A:A"), "organic", Range("E:E"))
paid_new = Application.SumIf(Range("A:A"), "paid", Range("E:E"))
direct_new = Application.SumIf(Range("A:A"), "direct", Range("E:E"))
referral_new = Application.SumIf(Range("A:A"), "referral", Range("E:E"))
display_new = Application.SumIf(Range("A:A"), "display", Range("E:E"))
sum_new = organic_new + paid_new + direct_new + referral_new + display_new
'calculate pages/visit
Dim pages_per_visit As String
pages_per_visit = (sum_pageviews / sum_visitors) / 100
'calculate organic traffic
Dim organic_percent As String
organic_percent = (organic_visitors / sum_visitors)
'calculate referral traffic
Dim referral_percent As String
referral_percent = (referral_visitors / sum_visitors)
'isolate start date
Dim date_location As String
Dim start_date_ugly As String
Dim start_date_string As String
date_location = ActiveWorkbook.Sheets(1).Range("A4")
start_date_ugly = Left(date_location, 10)
start_date_string = Right(start_date_ugly, 8)
'isolate end date
Dim end_date_string As String
end_date_string = Right(date_location, 8)
'posts data to columns
table_object_row.Range(1, 1).Value = DateSerial(Left(start_date_string, 4), Mid(start_date_string, 5, 2), Right(start_date_string, 2))
table_object_row.Range(1, 1).NumberFormat = "mm/dd/yyyy"
table_object_row.Range(1, 2).Value = DateSerial(Left(end_date_string, 4), Mid(end_date_string, 5, 2), Right(end_date_string, 2))
table_object_row.Range(1, 2).NumberFormat = "mm/dd/yyyy"
table_object_row.Range(1, 3).Value = sum_pageviews
table_object_row.Range(1, 4).Value = sum_visitors
table_object_row.Range(1, 5).Value = sum_new
table_object_row.Range(1, 6).Value = Format((pages_per_visit), Percent)
table_object_row.Range(1, 7).Value = organic_percent
table_object_row.Range(1, 8).Value = referral_percent
Else
'Informs user that the URL was not found (redundant, because script will default to Error Message if it encounters a problem)
'It's better to have the error message end the script outside of the loop sequence because it will stop the loop at the problem URL,
'allowing the user to add the URL manually, then click import again to pick up where they left off.
MsgBox strSearch & " was not found."
End If
'sets the currently active workbook name as a variable called xFullName
xFullName = Application.ActiveWorkbook.FullName
'Closes and deletes workbook by name
wb.Close SaveChanges:=False
Kill xFullName
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'END OF LOOP EVENTS
'Message box when tasks are completed
MsgBox "CSVs have been imported."
ResetSettings:
'Reset Macro Optimization settings by turning on screen updating
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
'Error Message that script defaults to if it can't complete (ie: if it encounters a URL not in the database) and finishes script
ErrMsg:
MsgBox strSearch & " is not in the spreadsheet. Please add it to the database before importing CSV data."
End Sub
编辑:Screenshot of CSV data这是CSV的样子。如果那周没有数据,那么整个单元格块A7:H11(实际上这个截图中缺少一个正常存在的行,并不总是设置的单元格范围)会丢失,A7会改为启动日索引表。