【原】Excel VBA【数据库】数据迁移：MySql数据库批量创建表、批量导入数据

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】【2023年8月】【2023年9月】

实用案例

|日期控件||简单的收发存||收费管理系(Access改进版)|

|电子发票管理助手||电子发票登记系统(Access版)|

|文件合并||表格拆分||审计凭证抽查底稿|

|中医诊所收费系统(Excel版)||中医诊所收费系统(Access版)|

收费使用项目

|财务管理系统||工资薪金和年终奖个税筹划|

内容提要

• MySql数据库表结构导入导出
• 数据迁移

大家好，我是冷水泡茶，昨天我们分享了【MySql数据库连接字符串/自定义函数】，今天我们继续分享VBA自定义函数操作MySQL数据库。

自定义函数getAllFields：

获取给定的数据库表的所有字段名：

 Function getAllFields(strCnn As String, tbl As String)    Dim rs As Object, cnn As Object    Dim arr()    Dim sql As String, i As Integer    Set cnn = CreateObject("ADODB.Connection")    Set rs = CreateObject("ADODB.Recordset")    cnn.Open strCnn    sql = "SHOW COLUMNS FROM " & tbl & ";"    rs.Open sql, cnn      i = 0    Do While Not rs.EOF        ReDim Preserve arr(i)        arr(i) = rs.Fields("Field").Value        i = i + 1        rs.MoveNext    Loop    rs.Close    Set rs = Nothing    cnn.Close    Set cnn = Nothing    getAllFields = arrEnd Function

这里的参数strCnn，连接字符串，应该包含数据库信息，tbl就是表名。返回值为一个数组。

使用方法：

Sub test1()    Dim clsDQ As New DataQuery    Dim strCnn As String    Dim dbs As String, tbl As String    Dim arr()    dbs = "acc_jyxgs_2023"    tbl = "tb_account"    strCnn = clsDQ.getStrCnn(user, psw, dbs)    arr = clsDQ.getAllFields(strCnn, tbl)    StopEnd Sub

我们这里的数据库是"acc_jyxgs_2023"，表是"tb_account"，是一张科目表。我已经创建好了，也写入了数据。这里注意一下，getStrDnn函数的参数改了，如前文所述，把SERVER给去掉了。

运行结果：

导出表字段名的用途很多，可以作为Excel表的表头，也可以作为ListView表头等等。

自定义函数getAllTableStructure：

导出一个数据库所有表的所有字段及其参数：

Function getAllTableStructure(strCnn As String, dbs As String)    '导出一个数据库所有表的字段，参数    Dim rs As Object, cnn As Object    Dim arr()    Dim sql As String, i As Integer    Set cnn = CreateObject("ADODB.Connection")    Set rs = CreateObject("ADODB.Recordset")    cnn.Open strCnn    sql = "SELECT table_name, column_name, " _        & "column_type,column_default FROM " _        & "information_schema.columns WHERE table_schema = '" & dbs & "';"    rs.Open sql, cnn    arr = rs.getrows    rs.Close    Set rs = Nothing    cnn.Close    Set cnn = Nothing    getAllTableStructure = arrEnd Function

调用方法：

Sub test2()    Dim arr()    Set ws = ThisWorkbook.Sheets("Sheet4")    dbs = "acc_jyxgs_2023"    strCnn = clsDQ.getStrCnn(user, psw, dbs)    arr = clsDQ.getAllTableStructure(strCnn, dbs)    For i = 0 To UBound(arr)        For j = 0 To UBound(arr, 2)            If IsNull(arr(i, j)) Then                arr(i, j) = ""            End If        Next    Next    ws.Range("a2").Resize(UBound(arr, 2) + 1, UBound(arr) + 1) = _    Application.WorksheetFunction.Transpose(arr)End Sub

这样就把"acc_jyxgs_2023"数据库里所有表的所有字段参数给导出来，存到"Sheet4"里。这里有for循环，是把NULL值替换为空，否则下面的Transpose函数会报错。

部分结果：

表头是手工添加的，根据这些信息，我们可以批量创建表。

自定义过程createTables：

批量创建数据库表，这是一个普通模块里的过程：

Sub createTables()    '根据Excel表中存储的表信息批量创建表    Dim cols As String '表字段    Dim tbl As String  '表名    Dim arr()    Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("CreateTable") arr = ws.UsedRange    Set cnn = CreateObject("ADODB.Connection")    dbs = "acc_jyxgs_2023" strCnn = clsDQ.getStrCnn(user, psw, dbs)    cnn.Open strCnn    For i = 2 To UBound(arr)        If arr(i, 1) <> "" Then            If arr(i, 1) <> arr(i - 1, 1) Then                m = i                tbl = arr(i, 1)                cols = ""            End If            If i = UBound(arr) Then                n = i            ElseIf arr(i, 1) <> arr(i + 1, 1) Then                n = i            End If            If i = n Then                For j = m To n                    If cols <> "" Then                        cols = cols & ","                    End If                    If arr(j, 4) <> "" Then                        If arr(j, 4) <> 0 Then                            cols = cols & "`" & arr(j, 2) & "` " & arr(j, 3) & " DEFAULT '" & arr(j, 4) & "' "                        Else                            cols = cols & "`" & arr(j, 2) & "` " & arr(j, 3) & " DEFAULT " & arr(j, 4) & " "   End If                    Else                        cols = cols & "`" & arr(j, 2) & "` " & arr(j, 3) & " "  End If                Next                sql = "CREATE TABLE  if not exists `" & tbl & "` ( " _                    & cols & ") ENGINE = InnoDB " _                    & "DEFAULT CHARACTER SET = utf8 " _                    & " COLLATE = utf8_danish_ci;" cnn.Execute (sql)                Debug.Print sql            End If        End If    Next    cnn.Close    Set cnn = NothingEnd Sub

运行这个过程，根据CreateTable表中存储的表结构信息，组合创建表的sql语句，批量在数据库"acc_jyxgs_2023"中创建表。

这里的CreateTable表，跟我们上面导出来的基本相同，不同的是在ID字段里加了AUTO_INCREMENT PRIMARY KEY参数。

其实，顺序应该是createTables在先，并且它不是从MySQL数据库里导出来的，是根据Access数据库中的表结构整理而来。

导出所有表、所有字段信息，是我原来在Access数据库中的做法，是想创建一个全新的数据库。在MySql数据库中，可能也没有必要这样做，这个根据以后实际操作过程的情况再看。

自定义过程importData：

从Excel文件中批量导入数据到MySql数据库：

Sub importData()    '从excel文件导入    'On Error Resume Next    Application.ScreenUpdating = False    Dim wb As Workbook, arr()    Dim ws As Worksheet    Dim filePath As String    Dim strTables As String    Dim lastRow As Integer, lastCol As Integer    Dim col As String, strCol As String    Dim tbl As String    dbs = "acc_yyxgs_2023"    Set cnn = CreateObject("ADODB.Connection")    Set rs = CreateObject("adodb.recordset")    strCnn = clsDQ.getStrCnn(ADMIN_USER, ADMIN_PSW, dbs)    arr = clsDQ.getAllTables(strCnn)    strTables = Join(arr, "/")    strTables = "/" & strTables    filePath = ThisWorkbook.Path & "\" & "甲有限公司（数据导入).xlsx"    Set wb = Workbooks.Open(filePath)    cnn.Open strCnn    For Each ws In wb.Sheets        tbl = ws.Name        If InStr(strTables, "/" & tbl & "/") Then            arr = clsDQ.getAllFields(strCnn, tbl)            strCol = Join(arr, "/")            strCol = "/" & strCol            If ws.Cells(2, 2) <> "" Then                Debug.Print ws.Name                lastRow = ws.UsedRange.Rows.Count                lastCol = ws.UsedRange.Columns.Count                rs.Open ws.Name, cnn, 1, 3                For i = 2 To lastRow                    If ws.Cells(i, 2) = "" Then Exit For                    rs.AddNew                    For j = 2 To lastCol                        If ws.Cells(1, j) = "" Then Exit For                        col = ws.Cells(1, j).Value                        If InStr(strCol, "/" & col & "/") Then                            rs.Fields(col).Value = ws.Cells(i, j).Value                        End If                    Next                    rs.Update                Next                rs.Close            End If        End If    Next    wb.Close savechanges:=False    cnn.Close    Set cnn = Nothing    Application.ScreenUpdating = TrueEnd Sub

应用场景是这样的：

1、我从原来的Access数据库中，把所有表的数据都导到一个Excel文件中，一个table一个Sheet，把sheet的名称改成与MySql数据库里的table名称相同，表头字段也相同（自动创建的，应该不会有不同）。

2、打开待导入的Excel文件，循环所有Sheet，读取数据，写入相应的MySql数据库表里。

至此，基本能够完成数据迁移的工作。

好，今天就到这，接下来要重点解决用户权限与登录的问题。

~~~~~~End~~~~~~

喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！