DATA_MIGRATION/SQL/SQLtoCSV/SQLtoCSV_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

''''''''''''''''''
''MS ACCESS VBA
''''''''''''''''''
Public Sub SQLtoCSV_ACC()
On Error GoTo ErrHandle
    Dim db As Database
    Dim tbldef As TableDef

    Set db = CurrentDb

    ' REMOVE PRIOR LINKED TABLE
    For Each tbldef In db.TableDefs
        If tbldef.Name = "CLData_linked" Then
            db.TableDefs.Delete ("CLData_linked")
        End If
    Next tbldef

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

    ' EXPORT CSV
    DoCmd.TransferText acExportDelim, , "CLData_linked", CurrentProject.Path & "\CLData.csv", True

    MsgBox "Successfully migrated SQL data to CSV!", vbInformation

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

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

End Sub


''''''''''''''''''
''MS EXCEL VBA
''''''''''''''''''
Public Sub SQLtoCSV_XL()
On Error GoTo ErrHandle
    Dim wb As Workbook
    Dim strPath, constr, sql As String
    Dim rs, cmd As Object
    Dim r, c As Long

    strPath = Application.ActiveWorkbook.Path

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

    ' QUERY DATABASE
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SELECT * FROM cldata", conn

    ' INTIALIZE CSV
    Set wb = Workbooks.Add()

    ' WRITE ROWS
    With wb.Sheets(1)
        ' HEADERS
        For c = 1 To rs.Fields.Count
            .Cells(1, c) = rs.Fields(c-1).Name
        Next c

        r = 2
        ' DATA ROWS
        Do While Not rs.EOF
           For c = 1 To rs.Fields.Count
               .Cells(r, c) = rs.Fields(c-1).Value
           Next c

           r = r + 1
           rs.MoveNext
        Loop

       .Name = "DATA"
    End With

    ' SAVE CSV
    wb.SaveAS strPath & "\CLData_XL.csv", xlCSV
    wb.Close True
    rs.Close: conn.Close

    MsgBox "Successfully migrated SQL data to CSV!", vbInformation

ExitHandle:
    Set rs = Nothing: Set conn = Nothing
    Set wb = Nothing
    Exit Sub

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

End Sub