DATA_MIGRATION/JSON/JSONtoSQL/JSONtoSQL_VBA.vb at master · ParfaitG/DATA_MIGRATION · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

''''''''''''''''''
'' MS ACCESS VBA
''''''''''''''''''
Public Sub JSONtoSQL_ACC()
On Error GoTo ErrHandle
    Dim db As Database, tbldef As TableDef, qdef As QueryDef
    Dim dbeError As Error
    Dim FileNum As Integer
    Dim DataLine, jsonStr, strPath, strSQL As String
    Dim p As Object, element As Variant

    ' DATABASE SETUP
    Set db = CurrentDb
    strPath = Application.CurrentProject.Path

    For Each tbldef In db.TableDefs
        If tbldef.Name = "CLData_Local" Or tbldef.Name = CLData_Linked" Then
            db.Execute "DROP TABLE " & tbldef.Name
        End If
    Next tbldef

    strSQL = "CREATE TABLE CLData_Local (  " _
              & "    [User]     Text(255), " _
              & "    [Category] Text(255), " _
              & "    [City]     Text(255), " _
              & "    [Post]     Text(255), " _
              & "    [Time]     Text(255), " _
              & "    [Link]     Text(255)  " _
              & ");"
    db.Execute strSQL

    ' READ JSON
    FileNum = FreeFile()
    Open strPath & "\CLData.json" For Input As #FileNum

    ' PARSE FILE STRING
    jsonStr = ""
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine

        jsonStr = jsonStr & DataLine & vbNewLine
    Wend
    Close #FileNum
    Set p = ParseJson(jsonStr)

    ' ITERATE DATA ROWS
    strSQL = "PARAMETERS [User] Text(255), [Category] Text(255), [City] Text(255)," _
              & "[Post] Text(255), [Time] Text(255), [Link] Text(255); " _
              & "INSERT INTO CLData_Local (user, category, city, post, [time], link) " _
              & " VALUES([User],[Category], [City], [Post], [Time], [link])"

    For Each element In p
        Set qdef = db.CreateQueryDef("", strSQL)

        qdef!User = element("user")
        qdef!Category = element("category")
        qdef!City = element("city")
        qdef!Post = element("post")
        qdef!Time = element("time")
        qdef!link = element("link")

        qdef.Execute
    Next element

    DoCmd.SetWarnings False

    ' LINK EXTERNAL TABLE
    DoCmd.TransferDatabase acLink, "ODBC Database", _
          "ODBC;"DRIVER=SQLite3 ODBC Driver;Database=" & CurrentProject.Path & "\CLData.db;", _
                  acTable, "CLData", "CLData_linked"

    ' RUN APPEND QUERY
    db.Execute "INSERT INTO CLData_linked SELECT * FROM CLData", dbFailOnError

    MsgBox "Successfully migrated JSON data to SQL database!", vbInformation

ExitHandle:
    DoCmd.SetWarnings True
    Set element = Nothing: Set p = Nothing
    Set qdef = Nothing: Set db = Nothing

    Set tbldef = Nothing: Set db = Nothing
    Set dbeError = Nothing
    Exit Sub

ErrHandle:
    For Each dbeError In DBEngine.Errors
        MsgBox dbeError.Number & ": " & dbeError.Description, vbCritical
    Next dbeError
    Resume ExitHandle

End Sub


''''''''''''''''''
'' MS EXCEL VBA
''''''''''''''''''
Public Sub JSONtoSQL_XL()
On Error GoTo ErrHandle
    Dim FileNum As Integer
    Dim DataLine As String, jsonStr As String
    Dim conn As Object, cmd As Object
    Dim strPath As String, constr As String, strSQL As String
    Dim p As Object, element As Variant, varKey As Variant

    strPath = ActiveWorkbook.Path

    ' READ FROM EXTERNAL FILE
    FileNum = FreeFile()
    Open strPath & "\CLData.json" For Input As #FileNum

    ' PARSE FILE STRING
    jsonStr = ""
    While Not EOF(FileNum)
        Line Input #FileNum, DataLine

        jsonStr = jsonStr & DataLine & vbNewLine
    Wend
    Close #FileNum

    Set p = ParseJson(jsonStr)

    ' OPEN DB CONNECTION
    Set conn = CreateObject("ADODB.Connection")
    constr = "DRIVER=SQLite3 ODBC Driver;Database=" & strPath & "\CLData.db;"
    conn.Open constr

    ' PREPARING SQL STATEMENT AND SETTINGS
    strSQL = "INSERT INTO cldata (user, category, city, post, time, link) " _
                    & "VALUES (?, ?, ?, ?, ?, ?)"

    ' APPEND TO DATABASE
    For Each element In p
        Set cmd = New ADODB.Command

        With cmd
            .ActiveConnection = conn
            .CommandText = strSQL
            .CommandType = adCmdText
            .CommandTimeout = 15
        End With

        ' BINDING PARAMETERS
        For Each varKey In element.Keys()
            cmd.Parameters.Append cmd.CreateParameter(varKey, adVarChar, adParamInput, 255)
            cmd.Parameters(0).Value = element(varKey)
        Next varKay

        cmd.Execute
    Next element

    conn.Close

    MsgBox "Successfully migrated JSON data to SQL database!", vbInformation

ExitHandle:
    Set element = Nothing: Set varKey = Nothing: Set p = Nothing
    Set cmd = Nothing: conn = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Resume ExitHandle

End Sub