问题描述

用VBA来取出MySQL数据库中的所有表的结构后生成一个Excel的文档

首先创建MySQL的数据源，如何创建数据源在前章已经写过，之后把下面的信息填写上即可

说明

DSN是你所创建的数据源的名称

SERVER是你本地的数据库

DB是你的数据库的名称

UID是登入数据库的用户名

PWD是登入数据库的密码

SCHEMA是你所创建的数据库的SCHEMA

之后在MysqlDbTable按钮下写入下面的代码即可

‘----------------mysqlからテーブル一覧出力---------------------------Private Sub getMysqlDbTeble_Click() Dim fiStr As String Dim dsnStr As String Dim serverStr As String Dim dbStr As String Dim uidStr As String Dim pwdStr As String Dim schemaStr As String Dim sheet As Worksheet Set sheet = ThisWorkbook.Sheets("Sheet1") dsnStr = sheet.Range("C2") serverStr = sheet.Range("C3") dbStr = sheet.Range("C4") uidStr = sheet.Range("C5") pwdStr = sheet.Range("C6") schemaStr = sheet.Range("C7") fiStr = ThisWorkbook.Path & "\QR_DBテーブル一覧.xlsx" Dim wb As Workbook Set wb = Workbooks.Open(fiStr) Dim sht As Object Set sht = wb.Sheets("テーブル一覧") sht.Range("A3:D" & sht.UsedRange.Rows.Count) = "" ‘MySql接続 Dim conn As ADODB.Connection Dim rs As ADODB.Recordset Set conn = New ADODB.Connection Set rs = New ADODB.Recordset ‘テーブル情報取得 conn.ConnectionString = "DSN=" & dsnStr & ";Server=" & serverStr & ";DB=" & dbStr & ";UID=" & uidStr & ";PWD=" & pwdStr & ";OPTION=3;" sqlStr = "select TABLE_NAME, TABLE_COMMENT from information_schema.tables where table_schema=‘" & schemaStr & "‘" conn.Open connStr Set rs = conn.Execute(sqlStr) Dim index As Integer index = 3 While Not rs.EOF sht.Range("A" & index) = index - 2 sht.Range("B" & index) = rs!TABLE_NAME sht.Range("C" & index) = rs!TABLE_COMMENT ‘テーブル定義情報 Dim shtName As String shtName = tebleInfo(conn, wb, rs!TABLE_NAME, rs!TABLE_COMMENT, index) sht.Hyperlinks.Add Anchor:=sht.Range("B" & index), Address:="", SubAddress:="‘" & shtName & "‘" & "!C2" rs.MoveNext index = index + 1 Wend rs.Close: Set rs = Nothing conn.Close: Set conn = Nothing wb.Close savechanges:=False MsgBox "完了"End Sub‘----------------mysqlからテーブル定義出力---------------------------Function tebleInfo(connTable As ADODB.Connection, wbTable As Workbook, tableNm As String, tableComment As String, idx As Integer) Dim rsTable As ADODB.Recordset Set rsTable = New ADODB.Recordset ‘検索テーブル定義情報 sqlStr = "select COLUMN_NAME, COLUMN_COMMENT, COLUMN_KEY, COLUMN_TYPE, COLUMN_DEFAULT ,IS_NULLABLE from information_schema.columns where TABLE_SCHEMA=‘zhd_sale_demo‘ and TABLE_NAME = ‘" & tableNm & "‘" Set rsTable = connTable.Execute(sqlStr) Worksheets("テンプレート").Copy before:=Worksheets("テンプレート") ‘シート名の長さが31文字以内 Dim sheetNm As String If Len(tableNm) > 31 Then sheetNm = Right(tableNm, 31) Else sheetNm = tableNm End If ‘シート名存在チェック Dim flag As Boolean flag = SheetIsExist(wbTable, sheetNm) If flag Then Application.DisplayAlerts = False ‘シート名存在したら、削除 wbTable.Sheets(sheetNm).Delete Application.DisplayAlerts = True End If ActiveSheet.Name = sheetNm Dim shtTable As Object Set shtTable = ActiveSheet shtTable.Range("C2") = tableNm shtTable.Range("E2") = tableComment ‘取得した Dim indexTable As Integer indexTable = 7 While Not rsTable.EOF ‘No shtTable.Range("A" & indexTable) = indexTable - 6 ‘項目物理名（EN） shtTable.Range("B" & indexTable) = rsTable!COLUMN_NAME ‘項目論理名（CH） shtTable.Range("C" & indexTable) = rsTable!COLUMN_COMMENT ‘KEY shtTable.Range("D" & indexTable) = rsTable!COLUMN_KEY ‘属性 shtTable.Range("E" & indexTable) = rsTable!COLUMN_TYPE ‘黙認 shtTable.Range("F" & indexTable) = rsTable!COLUMN_DEFAULT ‘NULL shtTable.Range("G" & indexTable) = rsTable!IS_NULLABLE rsTable.MoveNext indexTable = indexTable + 1 Wend tebleInfo = sheetNmEnd FunctionFunction SheetIsExist(wbCheck As Workbook, shtNm As String) SheetIsExist = False On Error GoTo lab1 Set shtSheet = wbCheck.Sheets(shtNm) If shtSheet Is Nothing Then SheetIsExist = False Else SheetIsExist = True End If Set shtSheet = Nothing Exit Functionlab1: SheetIsExist = FalseEnd Function

最总实现的效果：