Import danych z Arkuszy Kaluklacyjnych Google.
Google API dot. Google SpreadSheets i interpretacja zwracaych przez Query.setResponse wyników.
  strona główna:
A po co ten Excel ;-)
 
 
 
    Choć dość rzadko idzie zastać mnie w weekend w domu to są od tej reguły  
wyjątki. Jeden z nich dotyczy sytuacji gdy moja druga połówka kontynuując  
studia cały weekend spędza na wykładach.   
    Że zawsze żal mi ładnych dni spędzonych w domu, a założenie że rodzinne  
wypady realizujemy CAŁĄ rodziną, nie pozwala mi realizować standardowych  
planów weekendowych ;-) …  
    Jak w temacie… dzisiaj chciałbym zająć się moim weekendowym zabijaniem  
czasu. ;-) (Przynajmniej coś pożytecznego, oprócz obiadu, udało mi się zrobić)  
 
A więc… mamy udostępniony "wszystkim co mają link" plik xls na dysku Google.   link do pliku
 
Najpierw przyjrzyjmy się adresowi skoroszytu z podziałem na składowe:  
 
https://docs.google.com/spreadsheet/  
        ccc?  
        key=0At5I98HJAddmdGNwZEJIc3ZNRE4yUjdBVnRrSWt2SlE  
        &usp=drive_web  
        #gid=0  
 
Ten klucz będzie wykorzystywany w procedurze importu danych i jest nadawany  
dla dokumentu poprzez udostępnienie.  
 
    W artykule  
Using a Google Spreadsheet as a Data Source  
można poczytać jak udostępnić nasz Skoroszyt i jak będzie wylądał link do  
Kwerendy z określonych danych wraz z opisem argumentów: gid=N; sheet=sheet_name; range=B10:B22 - to będzie potrzebne!!  
 
na podstawie tych informacji stworzyłem adres  
    Const DocKey As String = "0At5I98HJAddmdGNwZEJIc3ZNRE4yUjdBVnRrSWt2SlE"  
    Const strArkName As String = "Arkusz1"  
    Const rngAddress As String = "A1:B5"  
          
    Dim strURL As String  
    strURL = "https://spreadsheets.google.com/" & _  
                    "tq?" & _  
                    "sheet=" & strArkName & "&" & _  
                    "range=" & rngAddress & "&" & _  
                    "key=" & DocKey  
 
Jeżeli "wrzucimy" taki adres na przeglądarkę to otrzymamy:  
 
// Data table response
google.visualization.Query.setResponse({"version":"0.6","status":"ok","sig":"1850906453","table":{"cols":[{"id":"A","label":"","type":"string","pattern":""},{"id":"B","label":"","type":"number","pattern":"#0.###############"}],"rows":[{"c":[{"v":"A1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":1.0,"f":"1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},{"c":[{"v":"A2","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":2.0,"f":"2","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},{"c":[{"v":"A3","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":3.0,"f":"3","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},{"c":[{"v":"A4","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":4.0,"f":"4","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},{"c":[{"v":"A5","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":5.0,"f":"5","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]}]}});
 
 
 
 
 
 
 
 
Trochu abstrakcja ale widać że "jakaś logika w tym jest" ;-) Jak dołożymy klika Enterów i spacji..  
 
// Data table response   
google.visualization.Query.setResponse(  
 
{"version":"0.6","status":"ok","sig":"1850906453","table":{  
 
cols:[  
   {"id":"A","label":"","type":"string","pattern":""},  
   {"id":"B","label":"","type":"number","pattern":"#0.###############"}],  
 
rows:[
   {"c":[{"v":"A1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":1.0,"f":"1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A2","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":2.0,"f":"2","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A3","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":3.0,"f":"3","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A4","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":4.0,"f":"4","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A5","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":5.0,"f":"5","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]}]}});
i z "tego trzeba wygrzebać nasze dane :-)  
 
Potrzebujemy więc funkcji która z Argumentu strURL kwerendy zwróci "zrozumiałą" tablicę 2D którą np.: zwrócimy do komórek.  
Zadanie to realizuje (względnie dobrze ;-) ) f: GoogleSpreadSheetsRange_to_tbl opisana poniżej:  
 
 
Function GoogleSpreadSheetsRange_to_tbl(strSheetURL As String)  
    Dim strGoogleShCode As String  
    strGoogleShCode = QueryResponse(strSheetURL)  
    If Len(strGoogleShCode) = 0 Then Exit Function  
    Dim tbl() As Variant  
      
    'Obsługa Błądów:  
      
    'JSON Response Format   Response Format
    'https://developers.google.com/chart/interactive/docs/dev/implementing_data_source  
      
    'status:  
        'ok - Successful request. A table must be included in the table property.  
        'warning - Success, but with issues. A table must be included in the table property.  
        'error - There was a problem. If you return this, you should not return table and must return errors.  
    'np:  
    'google.visualization.Query.setResponse({"version":"0.6", _  
                                             "status":"error", _  
                                             "errors":[{"reason":"access_denied", _  
                                                        "message":"Access denied", _  
                                                        "detailed_message":"Access denied"}]});  
 
    If Left(strGoogleShCode, InStr(strGoogleShCode, "status") + 20) Like "*""status"":""error""*" Then  
        MsgBox Mid(strGoogleShCode, InStr(strGoogleShCode, "status"), Len(strGoogleShCode))  
        Exit Function  
    End If  
      
    'google.visualization.Query.setResponse({"version":"0.6", _  
                                             "status":"ok", _  
                                             "sig":"1435977584", _  
                                             "table": ...  
      
    'struktura danych  
    'columny  
    Dim strCols As String: strCols = Mid(strGoogleShCode, _  
                                         InStr(strGoogleShCode, "cols") + 8, _  
                                         InStr(strGoogleShCode, "rows") - _  
                                           InStr(strGoogleShCode, "cols") - 12)  
    Dim arrCols() As String: arrCols = Split(strCols, "},{")  
    'Debug.Print Join(arrCols, vbCrLf)  
      
    Dim arrFormats() As String, f As Integer  
    ReDim arrFormats(0 To UBound(arrCols))  
    For f = 0 To UBound(arrCols)  
        arrFormats(f) = Replace(Split(arrCols(f), ",")(2), """type"":", "")  
    Next  
      
    'wiersze  
    Dim strRows As String: strRows = Mid(strGoogleShCode, _  
                                         InStr(strGoogleShCode, "rows") + 13, _  
                                         Len(strGoogleShCode) - InStr(strGoogleShCode, "rows") - 19)  
    Dim arrRows() As String: arrRows = Split(strRows, "]},{""c"":[")  
    Dim arrRow() As String  
 
    'Debug.Print Join(arrRows, vbCrLf)  
      
    Dim iR As Long: iR = UBound(arrRows)  
    Dim iC As Integer: iC = UBound(arrCols)  
      
    ReDim tbl(1 To iR + 1, 1 To iC + 1)  
    Dim i As Long, j As Integer  
      
    Dim arrCells() As String, strCell As String  
    Dim arrNr As Integer  
      
    For i = 0 To iR  
        arrRows(i) = Replace_RegExp2(arrRows(i), "(^,+|,{2,})", "|")  
        arrRows(i) = Replace(arrRows(i), "},{", "}|{")  
        arrRow = Split(arrRows(i), "|")  
 
        'Debug.Print Join(arrRow, vbCrLf)  
        For j = 0 To iC  
            If Len(arrRow(j)) > 0 Then  
                arrCells = Split(arrRow(j), ",""")  
                arrNr = IIf(arrCells(0) Like "*new Date(*", 1, 0)  
                'Debug.Print Join(arrCells, vbCrLf)  
                strCell = Replace(Replace(arrCells(arrNr), "{""v"":", ""), "}", "")  
                tbl(i + 1, j + 1) = NaWartosc(strCell, arrFormats(j))  
            End If  
        Next  
    Next  
 
    GoogleSpreadSheetsRange_to_tbl = tbl  
End Function  
 
Function QueryResponse(strURL) As String  
    Dim msXML As Object  
    Set msXML = CreateObject("Microsoft.XMLHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
        QueryResponse = .responseText  
    End With  
    Set msXML = Nothing  
End Function  
 
Function NaWartosc(sText As String, sFormat As String) As Variant  
    If sText = "null" Then Exit Function  
 
    Select Case sFormat  
        Case """string""": NaWartosc = Replace(sText, """", "")  
        Case """number""": NaWartosc = Replace(sText, ".", ",") * 1  
        Case """date""": NaWartosc = VBA.DateValue(Mid(sText, 5, 10))  
        Case Else: NaWartosc = sText  
    End Select  
End Function  
 
Function Replace_RegExp2(strText As String, _  
                         strFind As String, _  
                         Optional vReplace As Variant = vbNullString) As String  
      
    On Error GoTo Replace_RegExp_Error  
 
    Dim objRegExp As Object 'VBScript.RegExp  
    Dim colMatches As Object, objMatch As Object  
    Dim newStr As String  
      
    Set objRegExp = VBA.CreateObject("VBScript.RegExp")  
    With objRegExp  
        .Global = True  
        .Pattern = strFind  
        If .Test(strText) Then  
            Set colMatches = objRegExp.Execute(strText)  
            For Each objMatch In colMatches  
                With objMatch  
                    newStr = Left(strText, .FirstIndex)  
                    newStr = newStr & String(.Length, vReplace)  
                    newStr = newStr & Right(strText, Len(strText) - .FirstIndex - .Length)  
                    strText = newStr  
                End With  
            Next  
            Replace_RegExp2 = newStr  
        Else  
            Replace_RegExp2 = strText  
        End If  
    End With  
      
Replace_RegExp_Exit:  
    Set objMatch = Nothing  
    Set colMatches = Nothing  
    Set objRegExp = Nothing  
    Exit Function  
      
Replace_RegExp_Error:  
    Replace_RegExp2 = strText  
    Resume Replace_RegExp_Exit  
      
End Function  
 
Przydługawa?? ;-) … Co ważniejsze:  
     
Tablica formatów kolumn: - z tego fragmentu:  
cols:[  
   {"id":"A","label":"","type":"string","pattern":""},  
   {"id":"B","label":"","type":"number","pattern":"#0.###############"}],  
 
poleceniami:  
    Dim strCols As String: strCols = Mid(strGoogleShCode, _  
                                         InStr(strGoogleShCode, "cols") + 8, _  
                                         InStr(strGoogleShCode, "rows") - _  
                                           InStr(strGoogleShCode, "cols") - 12)  
    Dim arrCols() As String: arrCols = Split(strCols, "},{")  
otrzemuję tablicę z:  
   "id":"A","label":"","type":"string","pattern":""  
   "id":"B","label":"","type":"number","pattern":"#0.###############"  
z którego poleceniami:  
    Dim arrFormats() As String, f As Integer  
    ReDim arrFormats(0 To UBound(arrCols))  
    For f = 0 To UBound(arrCols)  
        arrFormats(f) = Replace(Split(arrCols(f), ",")(2), """type"":", "")  
    Next  
dzieląc elementy po przecinkach, w 2'gim (licząc od zera) fragmencie mamy np.: "type":"string"  
Całość tworzy tablicę z zapisanymi formatami danych dla każdej kolumny jakie będę nadawał wartościom w tych kolumnach.  
Format ten określa najprawdopodobniej pierwsza wartość w danej kolumnie. Niby działa na mieszanych formatach nawet nieźle. To  
jednak nie polecam mieszania formatów w kolumnach.  
 
Tablica całych wierszy: - z fragmentu:  
rows:[
   {"c":[{"v":"A1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":1.0,"f":"1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A2","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":2.0,"f":"2","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A3","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":3.0,"f":"3","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A4","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":4.0,"f":"4","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]},
   {"c":[{"v":"A5","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":5.0,"f":"5","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}]}]}});
poleceniami:  
    Dim strRows As String: strRows = Mid(strGoogleShCode, _  
                                         InStr(strGoogleShCode, "rows") + 13, _  
                                         Len(strGoogleShCode) - InStr(strGoogleShCode, "rows") - 19)  
    Dim arrRows() As String: arrRows = Split(strRows, "]},{""c"":[")  
odcinam początek i koniec oraz dzielę ciąg po: ]},{"c":[  
zostaje np.:  
   {"v":"A1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}},{"v":1.0,"f":"1","p":{"style":"color: rgb(0, 0, 0);font-family:Dialog;"}}  
ale tylko w wierszach w których wszystkie elementy są wypełnione. :-) I tu pojawia się kolejna trudność.   
 
 
Tablica ma zawsze tyle samo elementów w każdym wierszu. Ale wiersze mogą być zapisane różnie np.:  
   {"v":"A1",...}},{"v":1.0,..}},{"v":1.0,..}},{"v":1.0,..}},{"v":1.0,..}}  
   ,{"v":1.0,..}},{"v":1.0,..}},{"v":1.0,..}},{"v":1.0,..}}  
   {"v":"A1",...}},,{"v":1.0,..}},{"v":1.0,..}},{"v":1.0,..}}  
   ,,{"v":1.0,..}},{"v":1.0,..}},{"v":1.0,..}}  
   {"v":"A1",...}},,,{"v":1.0,..}},{"v":1.0,..}}  
itp. Kolejne elementy wiersza są rozdzielone przecinkami ale w danym elemencie może być zagnieżdżona inna tablica również  
rozdzielana przecinkami :-) Elementów w wierszu może być… no… nie mało, a wypełnionych, a więc nie pominiętych, np.: tylko  
kilka. Jak więc rozdzielić "wiersz" na elementy?? Na pewno przez RegExp. Metoda która mi tu najbardziej pasowała to Replace ale..  
z tego co rozumiem tą Metodę, odszukane elementy są zastępowane przez określony znak/ciąg. Mam więc pattern np.: ",{2,}"  
co oznacza: przecinek przynajmniej dwa razy. Trafiłem na ",," i zastępuję go "||" (chr(124)), ale… jak trafię na ",,," to jak   
sprawić żeby dopasowanie było zastąpione trzema znakami Chr(124)??  
Napisałem taką funkcję:  
 
Function Replace_RegExp2(strText As String, _  
                         strFind As String, _  
                         Optional vReplace As Variant = vbNullString) As String  
      
    On Error GoTo Replace_RegExp_Error  
 
    Dim objRegExp As Object 'VBScript.RegExp  
    Dim colMatches As Object, objMatch As Object  
    Dim newStr As String  
      
    Set objRegExp = VBA.CreateObject("VBScript.RegExp")  
    With objRegExp  
        .Global = True  
        .Pattern = strFind  
        If .Test(strText) Then  
            Set colMatches = objRegExp.Execute(strText)  
            For Each objMatch In colMatches  
                With objMatch  
                    newStr = Left(strText, .FirstIndex)  
                    newStr = newStr & String(.Length, vReplace)  
                    newStr = newStr & Right(strText, Len(strText) - .FirstIndex - .Length)  
                    strText = newStr  
                End With  
            Next  
            Replace_RegExp2 = newStr  
        Else  
            Replace_RegExp2 = strText  
        End If  
    End With  
      
Replace_RegExp_Exit:  
    Set objMatch = Nothing  
    Set colMatches = Nothing  
    Set objRegExp = Nothing  
    Exit Function  
      
Replace_RegExp_Error:  
    Replace_RegExp2 = strText  
    Resume Replace_RegExp_Exit  
      
End Function  
 
A więc: Jeżeli dojdzie do dopasowania .Test(strText) stworzę MatchCollection wszystkich dopasowań i utworzę nowy ciąg:  
 - od lewej do dopasowania po staremu: newStr = Left(strText, .FirstIndex)  
 - dopasowanie zmieniam na nowy ciąg tyle razy jak długie jest dopasowanie: newStr = newStr & String(.Length, vReplace)  
 - od końca dopasowania do końca ciągu po staremu: newStr & Right(strText, Len(strText) - .FirstIndex - .Length)  
i tak w pętli dla całej kolekcji dopasowań.
 
dla przykładu: ->>   
w bieżącym zadaniu:  
 
        arrRows(i) = Replace_RegExp2(arrRows(i), "(^,+|,{2,})", "|")  
        arrRows(i) = Replace(arrRows(i), "},{", "}|{")  
Tak zmieniony ciąg oznaczający wiersz danych dzielę na elementy po Chr(124) - "|"  
        arrRow = Split(arrRows(i), "|")  
 
Reszta to już proste wydobycie wartości i ich format    przykład do pobrania:
zapisany w arrFormaty()   importzgoogle.zip
Ostatecznie zaimportowane dane pokrywają się z  
danymi z Arkusza Google.