이게 뭐야?

Redash는 편리합니다만, 아무래도 Excel로 가공하고 싶은 등의 요구는 아직 남아 있다고 생각합니다.
이전에, 일일이 Redash로부터 데이터를 복사하지 않아도 되는 방법을 기사로 했습니다만, 그 방법으로는 50 시트째 당부터 괴로워지고 있어 메모리 부족으로 떨어지게 되었습니다.

참고:
Redash의 데이터를 매일 엑셀에 복사하는 사람에게 바친다 -API를 이용한 자동 갱신 방법-
ぃ tp // 이 m / 아오 안경 / ms / 63f0 아 5086fd045 예 0067

그래서 더 이상 VBA를 쓸 수밖에 없다! 그래서 VBA를 써 보았습니다.

소스 코드

디자인

같은 이름의

Redash의 API를 두드리고 CSV를 얻는다

CSV를 구문 분석하고 시트에 씁니다

라는 것을 하고 있습니다.

코드

Sub Main()
    'RedashAPIを使用するための変数
    Const ApiToken = "YOUR-API-KEY"
    Dim Url As String

    '取り込むRedashのQueryIdを定義する
    TargetQueryIds = Array("939", "1434", "879", "806", "1042", "1337", "876", "895", "897", "1338", "1339", "833", "885", "835", "1568", "1002", "1408")

    'Queryごとにループを回す
    For Each tqid In TargetQueryIds
        Url = "https://YOUR-REDASH-URL/api/queries/" + tqid + "/results.csv?api_key=" + ApiToken

        'Redash のAPIを叩き 結果をCSVとして取得する
        Dim ResultCsv As String
        ResultCsv = GetContents(Url)

        '同名称のシートがあれば削除し、新しいシートにデータを保存する
        MakeRefreshedSheet (tqid)
        CsvToSheet (ResultCsv)
    Next
End Sub

'ReadshのAPIを叩いてCSVで返す
Function GetContents(Url As String) As String
    Dim XmlHttp As Object
    Set XmlHttp = CreateObject("MSXML2.XMLHTTP")
    XmlHttp.Open "GET", Url, False
    XmlHttp.Send
    GetContents = XmlHttp.ResponseText
End Function

'CSVをシートに書き込む
Function CsvToSheet(ResultCsv As String)
    StringLines = Split(ResultCsv, vbCrLf) '改行コードでSplitして行に分割する
    i = 0
    For Each sl In StringLines '1行ずつ処理
        CellValues = Split(sl, ",")
        j = 0
        For Each c In CellValues  '1列ずつ処理
            Cells(i + 1, j + 1).Value = c
            j = j + 1
        Next
        i = i + 1
    Next
End Function

'同名のシートがあれば削除し、新規のシートをつくる
Function MakeRefreshedSheet(sname As String)
     If ExistsWorksheet(sname) Then
        Application.DisplayAlerts = False
        Worksheets(sname).Delete
        Application.DisplayAlerts = True
     End If
     Set wSheet = Worksheets.Add
     wSheet.name = sname
End Function

'ワークシートの存在チェックを返す
Function ExistsWorksheet(sname As String)
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.name = sname Then '存在する => True
            ExistsWorksheet = True
            Exit Function
        End If
    Next
    ExistsWorksheet = False '存在しない => False
End Function

빠는거리

Redash의 jsonAPI는 열 순서가 화면과 다릅니다.
그래서 이번에는 CSV를 반환하는 API를 사용하기로 결정했습니다.

화면