estatistics
Level: Trainee
Registered: 15-05-2013
Posts: 1
|
Re: Data Type Mismatch - What does it mean..??
i have the folloing api code for google analytics for Statistica
why did i get the message "missmatch...."?
'#Reference {C9E29001-3D45-11D4-9FF4-00C04FA0D540}#1.0#0#C:\Program Files\StatSoft\STATISTICA 10\stl_mgra.dll#STATISTICA Graphics Type Library#STATISTICAGraphics
'#Reference {140CB7E3-2327-4186-AEA5-BB353F338D13}#1.0#0#C:\PROGRA~1\StatSoft\STATIS~3\StaSpreadsheet.dll#StatSoft STATISTICA Spreadsheet Library#StaSpreadsheetLib
'#Reference {BE35B7EB-0D00-44D8-B3A5-0727DF5AD7C1}#1.0#0#C:\Program Files\StatSoft\STATISTICA 10\Dictionary.dll#StatSoft STATISTICA Dictionary Library#DICTIONARYLib
'#Reference {000204EF-0000-0000-C000-000000000046}#6.0#9#c:\windows\SysWow64\msvbvm60.dll#Visual Basic For Applications#VBA
'#Reference {F5078F18-C551-11D3-89B9-0000F81FE221}#6.0#0#C:\Windows\System32\msxml6.dll#Microsoft XML, v6.0#MSXML2
'This example macro will query the Google Analytics database and return various metrics/dimensions associated with external user visits to the
' user's organizational website.
'To use this macro, the user's organization must have an established Google Analytics account (obtainable here:
' http://www.google.com/analytics/) with a valid e-mail address and password available to the user.
'
'This example macro consists of one main procedure and seven (7) public and private sub-procedural functions:
'
'Sub Main - Contains the calls to the functions that execute the different steps in the macro.
'
'Function InitializeGranularityArray - Creates the array used to present time-frame options to the user in the function FilterGADataDialog
'Function InitializeMetricsArray - Creates the array used to present the user with various metric and dimension options in the
' function FilterGADataDialog
'Function AuthenticationDialog - Presents the input dialog for the user to enter his/her organization's valid Google Analytics e-mail address
' and password.
'Function getGAauthenticationToken - Uses the user-entered Google Analytics e-mail address and password to obtain the authentication token
' information necessary to obtain the desired Google Analytics metrics and dimensions data.
'Function getGAProfile - Uses the authentication token returned from the function getGAauthenticationToken to obtain associated profile information
' including account names, profile numbers, and profile titles for the user's organization.
'Function FilterGADataDialog - Presents the user with choices of profile titles, data ranges for which the metrics are desired, and a selection of
' up to six (6) different metrics possible at a single time.
'Function GetGAData - Uses the authentication token, profile, date range, and metric selection information to parse the XML Google Analytics data and
' return the desired information to the output spreadsheet.
'#Language "WWB-COM"
Option Base 1
Option Explicit
'Declaration of global variables
Dim sMetricsArray(0 To 18) As String 'By default, STATISTICA dialog arrays are zero-based, irrespective of the Option Explicit keywords.
Dim sGranularityArray(0 To 1) As String
Dim sGooglePass As String
Dim sGoogleMail As String
Dim sSessionToken As String
Dim sWebsitesArray() As Variant
Dim sProfilesArray() As Variant
Sub Main
If Not InitializeGranularityArray() Then Exit Sub 'Boolean functions return FALSE if error is encountered; subroutine where the error
If Not InitializeMetricsArray() Then Exit Sub 'occurs displays the error message. Return of FALSE value stops the macro.
If Not AuthenticationDialog() Then Exit Sub
End Sub
Public Function AuthenticationDialog() As Boolean 'Presents dialog for user to enter Google Analytics e-mail address and password
AuthenticationDialog = True
On Error GoTo ErrAuthenticationDialog
Do
Begin Dialog UserDialog 400,154 ' %GRID:10,7,1,1
GroupBox 10,7,380,147,"Google Authentication Information",.GroupBox1
Text 30,42,90,21,"E-Mail: ",.Text1
TextBox 140,42,210,21,.TextBox1
Text 30,77,90,14,"Password: ",.Text2
TextBox 140,77,210,21,.TextBox2,-1
OKButton 100,119,100,21
CancelButton 220,119,80,21
End Dialog
Dim dlg As UserDialog
If Dialog (dlg) Then
sGoogleMail = dlg.TextBox1
sGooglePass = dlg.TextBox2
If sGoogleMail <> "" And sGooglePass <> "" Then 'Proceed only if user enters both a valid Google eMail address
'and the valid associated Google eMail password
If Not getGAauthenticationToken(sGoogleMail, sGooglePass, sSessionToken) Then Exit All 'Returns the session authentication token
sProfilesArray = GetGAProfiles(sSessionToken, False)
Dim i As Long
Dim lMax As Long
lMax = UBound(sProfilesArray,1)
ReDim sWebsitesArray(LBound(sProfilesArray,1) To UBound(sProfilesArray,1)) As Variant 'Dimension websites array to be same size as
'profiles array
For i = LBound(sProfilesArray,1) To UBound(sProfilesArray,1) 'Create one-dimension array of profile titles for presentation to the
sWebsitesArray(i) = sProfilesArray(i,2) 'user in FilterGADataDialog
Next i
If Not FilterGADataDialog() Then Exit Function 'Calls function to present user with profile, date range, metric &
'dimension data options
ElseIf sGoogleMail <> "" Then
MsgBox CStr("Please enter a password.")
ElseIf sGooglePass <> "" Then
MsgBox CStr("Please enter an e-mail address.")
Else
MsgBox CStr("Please enter values for both the e-mail address and the password.")
End If
Else
Exit Function
End If
Loop Until sGoogleMail <> "" And sGooglePass <> "" 'Don't proceed until user enters valid Google Analytics e-mail and password
Exit Function
ErrAuthenticationDialog:
AuthenticationDialog = False
MsgBox CStr("Error encountered while processing authentication dialog. Procedure is closing." & vbCrLf & Err.Number & vbCrLf & Err.Description)
End Function
Public Function FilterGADataDialog() As Boolean
FilterGADataDialog = True
On Error GoTo ErrFilterGADataDialog
Dim bRunProc As Boolean
Dim dStartDate As Date
Dim dEndDate As Date
Do
bRunProc = True 'This flag is used to ensure that the user enters appropriate information: valid date ranges, valid profile, etc.
ReRunDialog:
Begin Dialog UserDialog 800,301,"Filters" ' %GRID:10,7,1,1
GroupBox 0,0,800,301,"Filter Data",.GroupBox1
DropListBox 160,28,210,21,sWebsitesArray(),.DropListBox1
Text 30,28,110,14,"Choose Profile:",.Text1
Text 30,70,110,14,"Metric:",.Text2
DropListBox 160,70,210,21,sMetricsArray(),.DropListBox2
OKButton 350,238,100,21
CancelButton 470,238,110,21
Text 30,105,90,14,"Granularity by:",.Text6
DropListBox 160,105,210,21,sGranularityArray(),.DropListBox4
GroupBox 400,28,370,182,"Dimensions (Select up to 6):",.GroupBox2
Text 30,133,340,14,"NOTE: Granularity by Week is selected by default.",.Text3
CheckBox 420,56,90,14,"Continent",.CheckBox1
CheckBox 420,70,110,14,"Country",.CheckBox2
CheckBox 420,84,100,14,"Region",.CheckBox3
CheckBox 420,98,110,14,"Language",.CheckBox4
CheckBox 420,112,100,14,"Browser",.CheckBox5
CheckBox 420,126,140,14,"Browser Version",.CheckBox6
CheckBox 420,140,150,14,"Operating System",.CheckBox7
CheckBox 420,154,120,14,"Screen Colors",.CheckBox8
CheckBox 420,168,110,14,"Page Path",.CheckBox9
CheckBox 420,182,180,14,"Is Mobile",.CheckBox10
CheckBox 600,56,150,14,"Network Domain",.CheckBox11
CheckBox 600,70,150,14,"Network Location",.CheckBox12
CheckBox 600,84,150,14,"User Defined Value",.CheckBox13
CheckBox 600,98,100,14,"Source",.CheckBox14
CheckBox 600,112,90,14,"Medium",.CheckBox15
CheckBox 600,126,90,14,"Keyword",.CheckBox16
CheckBox 600,140,100,14,"Campaign",.CheckBox17
CheckBox 600,154,110,14,"Ad Content",.CheckBox18
CheckBox 600,168,90,14,"Ad Group",.CheckBox19
CheckBox 600,182,90,14,"Ad Slot",.CheckBox20
GroupBox 30,161,270,126,"Enter dates in MM/DD/YYYY format:",.GroupBox3
TextBox 120,182,160,21,.TextBox1
Text 40,189,80,14,"Start Date:",.Text4
Text 40,224,80,14,"End Date:",.Text5
TextBox 120,224,160,21,.TextBox2
End Dialog
Dim dlg As UserDialog
'Process dialog selections
If Dialog (dlg) Then
Dim vProfileNumber As Variant
Dim vMetric As String
Dim sDimension As String
Dim sCFilter As String
Dim sGranularity As String
Dim lCounter As Long
'Get the profile number
If dlg.DropListBox1 <> -1 Then
vProfileNumber = sProfilesArray(dlg.DropListBox1,3)
Else
MsgBox CStr("Please select a valid profile.")
bRunProc = False
End If
'Formatting date
If IsDate(dlg.TextBox1) And IsDate(dlg.textbox2) Then
dStartDate = CDate(Format(dlg.TextBox1,"mm/dd/yyyy"))
dEndDate = CDate(Format(dlg.TextBox2, "mm/dd/yyyy"))
If dEndDate < dStartDate Then
MsgBox CStr("Please ensure that the end date does not occur earlier than the start date.")
bRunProc = False
End If
ElseIf IsDate(dlg.TextBox2) Then
If bRunProc Then MsgBox CStr("Please enter a start date value.")
bRunProc = False
ElseIf IsDate(dlg.TextBox1) Then
If bRunProc Then MsgBox CStr("Please enter an end date value.")
bRunProc = False
Else
If bRunProc Then MsgBox CStr("Please enter a start date and an end date.")
bRunProc = False
End If
If bRunProc Then
' Logic handling different dimensions/metrics posibilities; creates query information used to fetch XML data from Google Analytics
vMetric = LCase(sMetricsArray( dlg.DropListBox2))
sGranularity = LCase(sGranularityArray(dlg.DropListBox4))
sDimension = ""
lCounter = 0
If dlg.checkbox1 Then
lCounter = lCounter + 1
sDimension = sDimension & "&continent"
End If
If dlg.checkbox2 Then
lCounter = lCounter + 1
sDimension = sDimension & "&country"
End If
If dlg.checkbox3 Then
lCounter = lCounter + 1
sDimension = sDimension & "®ion"
End If
If dlg.checkbox4 Then
lCounter = lCounter + 1
sDimension = sDimension & "&language"
End If
If dlg.checkbox5 Then
lCounter = lCounter + 1
sDimension = sDimension & "&browser"
End If
If dlg.checkbox6 Then
lCounter = lCounter + 1
sDimension = sDimension & "&browserversion"
End If
If dlg.checkbox7 Then
lCounter = lCounter + 1
sDimension = sDimension & "&operatingsystem"
End If
If dlg.checkbox8 Then
lCounter = lCounter + 1
sDimension = sDimension & "&screencolors"
End If
If dlg.checkbox9 Then
sCFilter = "pagepath!=(other)"
If vMetric = "timeonsite" Then vMetric = "timeonpage"
If vMetric = "visits" Then vMetric = "uniquepageviews"
Else
sCFilter = ""
End If
If dlg.CheckBox10 Then
lCounter = lCounter + 1
sDimension = sDimension & "&isMobile"
End If
If dlg.CheckBox11 Then
sDimension = sDimension & "&networkDomain"
End If
If dlg.CheckBox12 Then
lCounter = lCounter + 1
sDimension = sDimension & "&networkLocation"
End If
If dlg.CheckBox13 Then
lCounter = lCounter + 1
sDimension = sDimension & "&userDefinedValue"
End If
If dlg.checkbox14 Then
lCounter = lCounter + 1
sDimension = sDimension & "&source"
End If
If dlg.checkbox15 Then
lCounter = lCounter + 1
sDimension = sDimension & "&medium"
End If
If dlg.checkbox16 Then
sDimension = sDimension & "&keyword"
lCounter = lCounter + 1
End If
If dlg.checkbox17 Then
sDimension = sDimension & "&campaign"
lCounter = lCounter + 1
End If
If dlg.checkbox18 Then
sDimension = sDimension & "&adcontent"
lCounter = lCounter + 1
End If
If dlg.checkbox19 Then
sDimension = sDimension & "&adgroup"
lCounter = lCounter + 1
End If
If dlg.checkbox20 Then
sDimension = sDimension & "&adslot"
lCounter = lCounter + 1
End If
If lCounter > 6 Then
MsgBox ("Please select no more than 6 dimensions")
GoTo ReRunDialog
End If
' End Dimension/Metric handling
Dim V() As Variant
If Not GetGAdata(V(), sSessionToken, vProfileNumber, vMetric, dStartDate, dEndDate,sCFilter,"year&" & sGranularity & sDimension, True,True) Then Exit All
Dim nVars As Long
Dim nCases As Long
nCases = UBound(V,1)
nVars = UBound(V,2)
Dim oSS As Spreadsheet
Set oSS = Spreadsheets.New
Dim i As Long
Dim j As Long
Dim sTempVarName As String
For i = 1 To nVars
sTempVarName = Trim(Replace(CStr(V(0,i)),"ga:",""))
oSS.VariableName(i) = UCase(Left(sTempVarName,1)) & Right(sTempVarName,Len(sTempVarName) - 1)
Next i
Dim data() As Variant
ReDim data(1 To nCases, 1 To nVars)
For i = 1 To UBound(V,1)
For j = LBound(V,2) To UBound(V,2)
data(i,j) = V(i,j)
Next j
Next i
'Return data to the output spreadsheet and display it to the user
oSS.Header = "Data returned for date range beginning on " & CStr(dStartDate) & " and ending on " & CStr(dEndDate) & "."
oSS.SetSize(nCases,nVars)
oSS.SetData(1,1, data)
oSS.AutoFitVariables (True)
oSS.EntireRange.AutoFit
Application.RouteOutput(oSS).Visible = True 'Outputs the spreadsheet containing the metrics/dimension data
End If
End If
Loop Until bRunProc
Exit Function
ErrFilterGADataDialog:
FilterGADataDialog = False
MsgBox CStr("Error encountered while retrieving desired metrics. Procedure is closing." & vbCrLf & Err.Number & vbCrLf & Err.Description)
End Function
Private Function InitializeMetricsArray() As Boolean 'Creates metrics array values to present to the user in the function FilterGADataDialog
InitializeMetricsArray = True
On Error GoTo ErrIMR
sMetricsArray(0) ="Time On Site"
sMetricsArray(1) ="Visits"
sMetricsArray(2) ="Page Views"
sMetricsArray(3) ="Entrances"
sMetricsArray(4) ="Bounces"
sMetricsArray(5) ="New Visits"
sMetricsArray(6) = "Unique Page Views"
sMetricsArray(7) ="Goal 1 Completions"
sMetricsArray(8) ="Goal 2 Completions"
sMetricsArray(9) ="Goal 3 Completions"
sMetricsArray(10) ="Goal 4 Completions"
sMetricsArray(11) ="Goal 5 Completions"
sMetricsArray(12) ="Goal 6 Completions"
sMetricsArray(13) ="Transaction Revenue"
sMetricsArray(14) ="Item Revenue"
sMetricsArray(15) ="Search Depth"
sMetricsArray(16) ="Search Exits"
sMetricsArray(17) ="Search Uniques"
sMetricsArray(18) ="Search Visits"
Exit Function
ErrIMR:
InitializeMetricsArray = False
MsgBox CStr("Error encountered initializing metrics array. Procedure is closing." & vbCrLf & Err.Number & vbCrLf & Err.Description)
End Function
Private Function InitializeGranularityArray() As Boolean 'Creates array of granularity choices to present to the user in the function FilterGADataDialog
InitializeGranularityArray = True
On Error GoTo ErrIGR
sGranularityArray(0) = "Week"
sGranularityArray(1) = "Month"
Exit Function
ErrIGR:
InitializeGranularityArray = False
MsgBox CStr("Error encountered initializing granular array. Procedure is closing." & vbCrLf & Err.Number & vbCrLf & Err.Description)
End Function
Public Function GetGAProfiles(sAuthToken As String, Optional bIncludeHeaders As Boolean = False) As Variant
'Fetches a list of profiles for the authenticated user
'
'Input authentication token produced by the getGAauthenticationToken function
'The output is three columns wide; it includes account names, profile numbers and profile titles
Dim sURL As String
On Error GoTo ErrGetGAProfiles
If sAuthToken = "Authentication failed" Then
GetGAProfiles = "Authentication failed"
Exit Function
End If
sURL = "https://www.google.com/analytics/feeds/accounts/default?max-results=10000"
Dim vObjhttp As Variant
Set vObjhttp = CreateObject("MSXML2.ServerXMLHTTP")
vObjhttp.Open "GET", sURL, False
vObjhttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
vObjhttp.setRequestHeader "Authorization", "GoogleLogin Auth=" & sAuthToken
vObjhttp.send ("")
Dim sGAResponse As String
sGAResponse = vObjhttp.responseText
If InStr(1, sGAResponse, "Token invalid") > 0 Or InStr(1, sGAResponse, "Authorization required") > 0 Then
GetGAProfiles = "Authentication failed"
Exit Function
End If
Dim xmDoc As MSXML2.DOMDocument
Dim xmnNode1 As MSXML2.IXMLDOMNode
Dim xmnNode2 As MSXML2.IXMLDOMNode
Dim xmlNodeList1 As MSXML2.IXMLDOMNodeList
Dim xmnNode3 As MSXML2.IXMLDOMNode
Dim xmlNodeList2 As MSXML2.IXMLDOMNodeList
Dim xmmNamedMap As MSXML2.IXMLDOMNamedNodeMap
Dim vTempArray() As Variant
Set xmDoc = New MSXML2.DOMDocument
xmDoc.loadXML (vObjhttp.responseText)
Set xmnNode1 = xmDoc.documentElement
Set xmlNodeList1 = xmnNode1.childNodes
Dim lCntr As Long, lNodeCntr As Long
Dim sAccounts() As String
lCntr = 1
For Each xmnNode2 In xmlNodeList1
If xmnNode2.nodeName = "openSearch:totalResults" Then
lNodeCntr = CLng(xmnNode2.Text)
If bIncludeHeaders Then
ReDim vTempArray(0 To lNodeCntr, 1 To 3) As Variant
Else
ReDim vTempArray(1 To lNodeCntr, 1 To 3) As Variant
End If
End If
If xmnNode2.nodeName = "entry" Then
Set xmlNodeList2 = xmnNode2.childNodes
For Each xmnNode2 In xmlNodeList2
If xmnNode2.nodeName = "dxp:property" Then
Set xmmNamedMap = xmnNode2.attributes
If xmmNamedMap.getNamedItem("name").Text = "ga:accountName" Then
vTempArray(lCntr, 1) = xmmNamedMap.getNamedItem("value").Text
End If
End If
If xmnNode2.nodeName = "dxp:tableId" Then vTempArray(lCntr, 3) = CDbl(Replace(xmnNode2.Text, "ga:", ""))
If xmnNode2.nodeName = "title" Then vTempArray(lCntr, 2) = xmnNode2.Text
Next xmnNode2
lCntr = lCntr + 1
End If
Next xmnNode2
If bIncludeHeaders Then
vTempArray(0, 1) = "Account Name"
vTempArray(0, 3) = "Profile Number"
vTempArray(0, 2) = "Profile Title"
End If
GetGAProfiles = vTempArray
Exit Function
ErrGetGAProfiles:
GetGAProfiles = "Fetching profiles failed"
End Function
Private Function getGAauthenticationToken(sEMail As String, sPassWord As String, sTheToken As String) As Boolean
'Fetches GA authentication token, which can then be used to fetch data with the function getGAdata function
'
On Error GoTo ErrGetGAAuthenticationToken
getGAauthenticationToken = True
Dim lCurChr As Long
Dim sTempAns As String
Dim sAuthResponse As String
Dim lAuthTokenStart As Long
If sEMail = "" Then
sTheToken = ""
Exit Function
End If
If sPassWord = "" Then
sTheToken = "Input password"
Exit Function
End If
lCurChr = 1
Do Until lCurChr - 1 = Len(sPassWord)
Select Case Asc(Mid(sPassWord, lCurChr, 1))
Case 48 To 57, 65 To 90, 97 To 122
sTempAns = sTempAns & Mid(sPassWord, lCurChr, 1)
Case 32
sTempAns = sTempAns & "%" & Hex(32)
Case Else
sTempAns = sTempAns & "%" & _
Format(Hex(Asc(Mid(sPassWord, _
lCurChr, 1))), "00")
End Select
lCurChr = lCurChr + 1
Loop
sPassWord = sTempAns
Dim vObjhttp
Dim sURL As String
Set vObjhttp = CreateObject("MSXML2.ServerXMLHTTP")
sURL = "https://www.google.com/accounts/ClientLogin"
vObjhttp.Open "POST", sURL, False
vObjhttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
vObjhttp.send ("accountType=GOOGLE&Email=" & sEMail & "&Passwd=" & sPassWord & "&service=analytics&Source=STATISTICA Data Import Tool")
sAuthResponse = vObjhttp.responseText
If InStr(1, sAuthResponse, "BadAuthentication") = 0 Then
Dim sAuthToken
lAuthTokenStart = InStr(1, sAuthResponse, "Auth=") + 4
sAuthToken = Right(sAuthResponse, Len(sAuthResponse) - lAuthTokenStart)
sTheToken = sAuthToken
Else
MsgBox ("Authentication failed!")
End
End If
Exit Function
ErrGetGAAuthenticationToken:
getGAauthenticationToken = False
MsgBox CStr("Errors encountered while authenticating e-mail address and password. Application is closing." & _
vbCrLf & Err.Number & vbCrLf & Err.Description)
End Function
Private Function GetGAdata(V() As Variant, sAuthToken As String, vProfileNumber As Variant, sMetrics As String, dStartDate As Date, dEndDate As Date, Optional sFilters As String, Optional sDimensions As String, Optional bSort As Boolean = False, Optional bIncludeHeaders As Boolean = False, Optional bShowArraySize As Boolean = False) As Boolean
'Fetches data from the GA profile specified, using the authentication token generated by the getGAauthenticationToken function
'
'The profile number is displayed in your browser's URL when you're viewing a report in GA. It is not the web property ID which begins with UA.
'
'Possible values for "metrics" can be found at http://code.google.com/intl/en-EN/apis/analytics/docs/gdata/gdataReferenceDimensionsmetrics.html#metrics
'For example visits, visitors, pageviews, bounces, timeOnSite. Multiple metrics can be added using ampersands as separators
'
'Filters can be any dimensions from this list: http://code.google.com/intl/fi-FI/apis/analytics/docs/gdata/gdataReferenceDimensionsmetrics.html#dimensions
'For example to get a metric for new visitors only, use "visitorType==New Visitor"
'Multiple filters can be added; use semicolons for AND and commas for OR operators
'Detailed instructions are here: http://code.google.com/intl/en-EN/apis/analytics/docs/gdata/gdataReference.html#filtering
'
'Dimensions can be added to split the data. You can add up to 7 different dimension separated by ampersands.
'The query can fetch a maximum of 10000 rows.
'
'Setting the sort parameter as True sorts the data by the metrics column, in descending order
'
'Requires a reference to "Microsoft XML, v.6.0" (or other version; this is done in the VBA editor from Tools > References, find the reference from the list and select).
On Error GoTo ErrGetGAData
GetGAdata = True
Dim vTempArray() As Variant
Dim lCntr As Long
Dim lNodeCntr As Long
Dim dResultsCount As Double
Dim dNodeListCount As Double
Dim sStartDateString As String
Dim sEndDateString As String
If sAuthToken = "" Then
GetGAdata = False
MsgBox "Authentication failed!"
End
End If
sStartDateString = Year(dStartDate) & "-" & Right("0" & Month(dStartDate), 2) & "-" & Right("0" & Day(dStartDate), 2)
sEndDateString = Year(dEndDate) & "-" & Right("0" & Month(dEndDate), 2) & "-" & Right("0" & Day(dEndDate), 2)
Dim sURL As String
sURL = "https://www.google.com/analytics/feeds/data?ids=ga:" & vProfileNumber & "&start-date=" & sStartDateString & "&end-date=" & sEndDateString & "&max-results=10000"
If sMetrics <> "" Then
sMetrics = Replace(sMetrics," ","")
If Left(sMetrics, 3) <> "ga:" Then sMetrics = "ga:" & sMetrics
sMetrics = Replace(sMetrics, "&", "&ga:")
sMetrics = Replace(sMetrics, "&ga:ga:", "&ga:")
Dim sTempAns As String
Dim lCurChr As Long
sTempAns = ""
lCurChr = 1
Do Until lCurChr - 1 = Len(sMetrics)
Select Case Asc(Mid(sMetrics, lCurChr, 1))
Case 37, 48 To 57, 65 To 90, 97 To 122
sTempAns = sTempAns & Mid(sMetrics, lCurChr, 1)
Case 32
sTempAns = sTempAns & "%" & Hex(32)
Case Else
sTempAns = sTempAns & "%" & _
Format(Hex(Asc(Mid(sMetrics, _
lCurChr, 1))), "00")
End Select
lCurChr = lCurChr + 1
Loop
sMetrics = sTempAns
sMetrics = Replace(sMetrics, "ga%00", "ga:")
sMetrics = Replace(sMetrics, "%26", "%2C")
sURL = sURL & "&metrics=" & sMetrics
End If
If sFilters <> "" Then
If Left(sFilters, 3) <> "ga:" Then sFilters = "ga:" & sFilters
sFilters = Replace(sFilters, ";", ";ga:")
sFilters = Replace(sFilters, ";ga:ga:", ";ga:")
sFilters = Replace(sFilters, ",", ",ga:")
sFilters = Replace(sFilters, ",ga:ga:", ",ga:")
sTempAns = ""
lCurChr = 1
Do Until lCurChr - 1 = Len(sFilters)
Select Case Asc(Mid(sFilters, lCurChr, 1))
Case 37, 42, 44, 46, 48 To 57, 59, 65 To 90, 97 To 122, 126
sTempAns = sTempAns & Mid(sFilters, lCurChr, 1)
Case 32
sTempAns = sTempAns & "%" & Hex(32)
Case Else
sTempAns = sTempAns & "%" & _
Format(Hex(Asc(Mid(sFilters, _
lCurChr, 1))), "00")
End Select
lCurChr = lCurChr + 1
Loop
sFilters = sTempAns
sFilters = Replace(sFilters, "ga%00", "ga:")
sFilters = Replace(sFilters, "%26", "%2C")
sURL = sURL & "&filters=" & sFilters
End If
If sDimensions <> "" Then
If Left(sDimensions, 3) <> "ga:" Then sDimensions = "ga:" & sDimensions
sDimensions = Replace(sDimensions, "&", "&ga:")
sDimensions = Replace(sDimensions, "&ga:ga:", "&ga:")
sTempAns = ""
lCurChr = 1
Do Until lCurChr - 1 = Len(sDimensions)
Select Case Asc(Mid(sDimensions, lCurChr, 1))
Case 37, 48 To 57, 65 To 90, 97 To 122
sTempAns = sTempAns & Mid(sDimensions, lCurChr, 1)
Case 32
sTempAns = sTempAns & "%" & Hex(32)
Case Else
sTempAns = sTempAns & "%" & _
Format(Hex(Asc(Mid(sDimensions, _
lCurChr, 1))), "00")
End Select
lCurChr = lCurChr + 1
Loop
sDimensions = sTempAns
sDimensions = Replace(sDimensions, "ga%00", "ga:")
sDimensions = Replace(sDimensions, "%26", "%2C")
sURL = sURL & "&dimensions=" & sDimensions
End If
If bSort Then sURL = sURL & "&bSort=-" & sMetrics
Dim vObjhttp
Set vObjhttp = CreateObject("MSXML2.ServerXMLHTTP")
vObjhttp.Open "GET", sURL, False
vObjhttp.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
vObjhttp.setRequestHeader "Authorization", "GoogleLogin Auth=" & sAuthToken
vObjhttp.send ("")
Dim sGAResponse As String
sGAResponse = vObjhttp.responseText
If InStr(1, sGAResponse, "Token invalid") > 0 Or InStr(1, sGAResponse, "Authorization required") > 0 Then
GetGAdata = False
MsgBox "Authentication failed"
End
End If
Dim xmDoc As MSXML2.DOMDocument
Dim xmnNode1 As MSXML2.IXMLDOMNode
Dim xmnNode2 As MSXML2.IXMLDOMNode
Dim xmlNodeList1 As MSXML2.IXMLDOMNodeList
Dim xmnNode3 As MSXML2.IXMLDOMNode
Dim xmlNodeList2 As MSXML2.IXMLDOMNodeList
Dim xmmNamedMap As MSXML2.IXMLDOMNamedNodeMap
Set xmDoc = New MSXML2.DOMDocument
xmDoc.loadXML (vObjhttp.responseText)
Set xmnNode1 = xmDoc.documentElement
Set xmlNodeList1 = xmnNode1.childNodes
For Each xmnNode2 In xmlNodeList1
If xmnNode2.nodeName = "openSearch:totalResults" Then
dResultsCount = CDbl(xmnNode2.Text)
End If
If xmnNode2.nodeName = "entry" Then
Set xmlNodeList2 = xmnNode2.childNodes
For Each xmnNode2 In xmlNodeList2
If xmnNode2.nodeName = "dxp:dimension" Or xmnNode2.nodeName = "dxp:metric" Then
dNodeListCount = dNodeListCount + 1
End If
Next xmnNode2
Exit For
End If
Next xmnNode2
If dResultsCount > 10000 Then dResultsCount = 10000
If dResultsCount = 0 And dNodeListCount = 0 Then
GetGAdata = False
MsgBox "No data found"
End
End If
ReDim vTempArray(1 To dResultsCount, 1 To dNodeListCount)
If bIncludeHeaders Then ReDim vTempArray(0 To dResultsCount, 1 To dNodeListCount)
If bShowArraySize Then
ReDim vTempArray(1 To 1, 1 To 1)
vTempArray(1, 1) = dNodeListCount & " columns * " & dResultsCount & " rows"
If bIncludeHeaders Then vTempArray(1, 1) = vTempArray(1, 1) & " + header row"
V() = vTempArray
Exit Function
End If
lCntr = 1
For Each xmnNode2 In xmlNodeList1
If xmnNode2.nodeName = "entry" Then
lNodeCntr = 1
Set xmlNodeList2 = xmnNode2.childNodes
For Each xmnNode2 In xmlNodeList2
If xmnNode2.nodeName = "dxp:dimension" Then
Set xmmNamedMap = xmnNode2.attributes
vTempArray(lCntr, lNodeCntr) = Left(xmmNamedMap.getNamedItem("value").Text, 255)
If lCntr = 1 And bIncludeHeaders Then vTempArray(0, lNodeCntr) = xmmNamedMap.getNamedItem("name").Text
lNodeCntr = lNodeCntr + 1
End If
If xmnNode2.nodeName = "dxp:metric" Then
Set xmmNamedMap = xmnNode2.attributes
If Not IsNumeric(xmmNamedMap.getNamedItem("value").Text) Then
vTempArray(lCntr, lNodeCntr) = CDbl(Replace(xmmNamedMap.getNamedItem("value").Text, ".", ","))
Else
vTempArray(lCntr, lNodeCntr) = CDbl(xmmNamedMap.getNamedItem("value").Text)
End If
If lCntr = 1 And bIncludeHeaders Then vTempArray(0, lNodeCntr) = xmmNamedMap.getNamedItem("name").Text
lNodeCntr = lNodeCntr + 1
End If
Next xmnNode2
lCntr = lCntr + 1
End If
Next xmnNode2
V() = vTempArray
Exit Function
ErrGetGAData:
GetGAdata = False
If Not IsNumeric(vProfileNumber) Then
MsgBox "Incorrect profile ID. You can see the correct ID from your browser's URL when you're viewing a report in GA."
End
Else
MsgBox "Fetching data failed"
End
End If
End Function
____________________________
sincerely,
Elias Estatistics eu
|
ocuments and SettingsAll UsersDocumentsPNR DoctorPNR Doctor.mdb"
