Google Trends; Automated download; Strange result

Hi,

please copy this link into your browsers address bar: http://www.google.com/trends/explore#cat=1104

Your are now able to download the visualized time series in csv format, by clicking the top right gear wheel looking button.
I use the following code to do this via vba:

Sub test()

    Dim b As Boolean
    Dim URL As String
    
    URL = "http://www.google.com/trends/viz#cat=1104&cmpt=q&graph=all_csv"
    
    b = DownloadFile(URL, Application.ActiveWorkbook.Path & "\report.csv", OverwriteKill, "BLUB")

End Sub

I you now open report.csv, you will see that it just contains the sites source code.

By pasting http://www.google.com/trends/viz?q=e...&graph=all_csv into the browsers addressbar, report.csv shows the expected results.

How do I build the url in a proper manner? I can't find any hints in the pages source code!

You have to copy this code into vba editor, to make the above lines executable:

Option Explicit
Option Compare Text

Public Enum DownloadFileDisposition
    OverwriteKill = 0
    OverwriteRecycle = 1
    DoNotOverwrite = 2
    PromptUser = 3
End Enum

Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" _
    Alias "PathIsNetworkPathA" ( _
    ByVal pszPath As String) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" _
    Alias "GetSystemDirectoryA" ( _
    ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long

Private Declare Function SHEmptyRecycleBin _
    Lib "shell32" Alias "SHEmptyRecycleBinA" _
    (ByVal hwnd As Long, _
     ByVal pszRootPath As String, _
     ByVal dwFlags As Long) As Long

Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const MAX_PATH As Long = 260

Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
                        "URLDownloadToFileA" ( _
                            ByVal pCaller As Long, _
                            ByVal szURL As String, _
                            ByVal szFileName As String, _
                            ByVal dwReserved As Long, _
                            ByVal lpfnCB As Long) As Long

Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
    "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Public Function DownloadFile(UrlFileName As String, _
                            DestinationFileName As String, _
                            Overwrite As DownloadFileDisposition, _
                            ErrorText As String) As Boolean

Dim Disp As DownloadFileDisposition
Dim Res As VbMsgBoxResult
Dim b As Boolean
Dim S As String
Dim L As Long

ErrorText = vbNullString

If Dir(DestinationFileName, vbNormal) <> vbNullString Then
    Select Case Overwrite
        Case OverwriteKill
            On Error Resume Next
            Err.Clear
            Kill DestinationFileName
            If Err.Number <> 0 Then
                ErrorText = "Error Kill'ing file '" & DestinationFileName & "'." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
    
        Case OverwriteRecycle
            On Error Resume Next
            Err.Clear
            b = RecycleFileOrFolder(DestinationFileName)
            If b = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
        
        Case DoNotOverwrite
            DownloadFile = False
            ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
            Exit Function
            
        Case Else
            S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
                "Do you want to overwrite the existing file?"
            Res = MsgBox(S, vbYesNo, "Download File")
            If Res = vbNo Then
                ErrorText = "User selected not to overwrite existing file."
                DownloadFile = False
                Exit Function
            End If
            b = RecycleFileOrFolder(DestinationFileName)
            If b = False Then
                ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                DownloadFile = False
                Exit Function
            End If
    End Select
End If
L = DeleteUrlCacheEntry(UrlFileName)
L = URLDownloadToFile(0&, UrlFileName, DestinationFileName, 0&, 0&)
If L = 0 Then
    DownloadFile = True
Else
    ErrorText = "Buffer length invalid or not enough memory."
    DownloadFile = False
End If
    
End Function
                            
Private Function RecycleFileOrFolder(FileSpec As String) As Boolean

    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long

    If (Dir(FileSpec, vbNormal) = vbNullString) And _
        (Dir(FileSpec, vbDirectory) = vbNullString) Then
        RecycleFileOrFolder = True
        Exit Function
    End If

    With FileOperation
        .wFunc = FO_DELETE
        .pFrom = FileSpec
        .fFlags = FOF_ALLOWUNDO

        .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
    End With

    lReturn = SHFileOperation(FileOperation)
    If lReturn = 0 Then
        RecycleFileOrFolder = True
    Else
        RecycleFileOrFolder = False
    End If
End Function

Thank you very much!
Lloyd

Any ideas?

Because the link that produces the csv uses the title, not the id

How do I trigger the csv download via the id?

You don't, you do it by the title, the code I gave you before gets you both

Kyle,

Sub GetTrends()

Dim jsObj As Object
Dim strJson As String
Dim objKeys As Object
Dim key
Dim x As Long: x = 1


Const strUrl As String = "http://www.google.com/trends/explore#cat="

With CreateObject("msxml2.xmlhttp")
    .Open "GET", "http://www.google.com/trends/explore", False
    .send
    strJson = Split(Split(.responsetext, "Category.setTreeData(")(1), ");")(0)
End With


With CreateObject("ScriptControl"): .Language = "JScript"
    .AddCode "function getP(e,k) { return e[k][0];}"
    .AddCode "var getall=function(e,t){var t=t||{};var n=undefined;var r;for(var i in e){if(i=='name'){n=e[i];continue}if(i=='id'){r=e[i];continue}var s=typeof e[i];if(s=='object'||s=='array'){t=getall(e[i],t)}}if(n!==undefined){if(t[n]===undefined){t[n]=[]}t[n].push(r)}return t}"
    .AddCode "function flatten(obj) { return getall(obj); }"
    .AddCode "function getKeys(e){var t=[];for(var n in e){t.push(n)}return t}"
    
    Set jsObj = .Run("flatten", .eval("(" & strJson & ")"))

    For Each key In .Run("getKeys", jsObj)
        Sheets(1).Cells(x, 1).Value = key
        Sheets(1).Cells(x, 2).Value = strUrl & .Run("getP", jsObj, key)
        x = x + 1
    Next key

End With

End Sub

your code produces a list looks like:

Celebrities & Entertainment News | http://www.google.com/trends/explore#cat=184

I don't see how to construct the url via the title!

I build the following url: http://www.google.com/trends/explore...ainment%20News

It is obviously the wrong syntax.

Lloyd

PHP Code: 

"http://www.google.com/trends/viz?q=" & replace(range("a1").value,"&","%2C%")  & "&cmpt=q&graph=all_csv" 


Would do it - you need to escape the & signs since they are reserved in urls

So how is it the wrong syntax? - If you'd said originally that this is what you were trying to do it would have been much easier

Now I got it!!!

Thanks Kyle!

Lloyd,

Would you mind sharing your final code please? I am working on a similar project to loop through Google's geographic codes but am running into trouble.

Thanks

DAK,

I don't have the code with me at the moment. I will upload some stuff in the coming days.

Lloyd

Thanks, Lloyd. In the meantime here's my code and where I am lost:

Sub DOWNLOADGOOGLE()

Application.ScreenUpdating = False

    Dim iLastRow As Integer
    Dim Rng As Range
    iLastRow = Range("E194").Row
    For Each Rng In Range("E12:E" & iLastRow)
        If Not Rng.Value = 0 Then
            Rng.Select
            Selection.Activate
            
        Dim myURL As String
        'This is looping through the google GeoCodes (ActiveCell) and including the search term entered in D4
        myURL = "http://www.google.com/trends/trendsReport?hl=en-US&geo=" & Format(ActiveCell.Value) & "q=" & Range("D4").Value & "&content=1&export=1"

        Dim WinHttpReq As Object
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", myURL, False
        WinHttpReq.Send

        myURL = WinHttpReq.ResponseBody
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.ResponseBody
        'The path below is supposed to save the CSV as whatever cell the loop is on
        oStream.SaveToFile ("C:\Documents and Settings\USER\Desktop\Google Trends\Program\Test\" & ActiveCell.Value & ".csv")
        oStream.Close
            
        End If
    Next Rng
    
End Sub

The macro sometimes comes to an error on the save to part, but I'm not sure if that has to do with the CSV files being empty or what. Any help is appreciated.

Thanks,
DAK

Lloyd,

I know you're busy running Goldman, but did you happen to find that code?

Thanks

Nevermind. I'm an idiot and forgot and & in front of my q= part of the code! It works now.

Hi,
I am writing a VBA for downloading a csv file from google trend.
I have tested the code in #1 .It runs but cannot return a proper csv file just like Lloyd said.
I do not understand what Kyle said. What do title and id refer to ?

I do not understand and cannot run the code in #6.
What is the input and ouput of this code?
When I run this, I face a Run- time error '-2147024891(80070005)'.

I am new in vba and sorry for my stupid questions.

really sorry about that

could anyone please give us the final code?

I am new on using VBA and I find it a bit tough to create a macro that will dowload google trends data straight to excel..

Thanks

could anyone please give us the final code?

I am new on using VBA and I find it a bit tough to create a macro that will dowload google trends data straight to excel..

Thanks