VBA to implement an existing database and get the structure of all tables

Problem description

Use VBA to remove the structure of all tables in the MySQL database into an Excel document

First create a MySQL data source, how to create a data source in the previous chapter has been written, and then fill in the following information can be

Description

DSN is the name of the data source you created

Server is your local database

DB is the name of your database

UID is the user name of the log in database

PWD is the password to log into the database

Schema is the schema of the database you created

Then write the following code under the Mysqldbtable button

'----------------mysqlからテーブル a---------------------------Private SubGetmysqldbteble_click ()DimFistr as String    DimDsnstr as String    DimServerstr as String    DimDbstr as String    DimUidstr as String    DimPwdstr as String    DimSchemastr as String        DimSheet asWorksheetSetSheet = 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"    DimWb asWorkbookSetWB =Workbooks.Open (FISTR)DimSht as Object    SetSht = wb. Sheets ("a テーブル") sht. Range ("a3:d"& Sht. UsedRange.Rows.Count) =""        'MySQL Connect Yobitsugi    DimConn asADODB. ConnectionDimRs asADODB. RecordsetSetconn =NewADODB. ConnectionSetrs =NewADODB. Recordset'テーブルof the situationConn. ConnectionString ="dsn="& Dsnstr &"; Server="& Serverstr &";D b="& Dbstr &"; Uid="& Uidstr &"; Pwd="& Pwdstr &"; option=3;"sqlstr="Select table_name, table_comment from Information_schema.tables where table_schema= '"& Schemastr &"'"Conn. Open ConnStrSetrs =Conn. Execute (SQLSTR)DimIndex as IntegerIndex=3     while  notRs. EOF Sht. Range ("A"& index) = index-2Sht. Range ("B"& index) =rs! TABLE_NAME Sht. Range ("C"& index) =rs! Table_comment'テーブル 's definition of emotion        DimShtname as StringShtname=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 +1Wend Rs. Close:Setrs = NothingConn. Close:Setconn = NothingWB. Close SaveChanges:=False        MsgBox "finished"End Sub'----------------mysqlからテーブル---------------------------FunctionTebleinfo (conntable asADODB. Connection, wbtable asWorkbook, Tablenm as String, tablecomment as String, IDX as Integer)    DimRstable asADODB. RecordsetSetRstable =NewADODB. Recordset'Eiken テーブル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 &"'"    SetRstable =Conntable.execute (sqlstr) Worksheets ("テンプレート"). Copy Before:=worksheets ("テンプレート")        'シート name さが31 text within    DimSheetnm as String    If Len(TABLENM) > to  ThenSHEETNM= Right(Tablenm, to)    ElseSHEETNM=TablenmEnd If       'シート name exists チェック    DimFlag as BooleanFlag=sheetisexist (wbtable, SHEETNM)IfFlag ThenApplication.DisplayAlerts=False        'シート name exists したら, truncatewbtable.sheets (SHEETNM). Delete Application.DisplayAlerts=True    End IfActivesheet.name=SHEETNMDimShttable as Object    SetShttable =ActiveSheet Shttable.range ("C2") =tablenm Shttable.range ("E2") =tablecomment'Get Beauty    DimIndextable as Integerindextable=7     while  notrstable.eof'NoShttable.range ("A"& indextable) = indextable-6        'Physical Name of item (EN)Shttable.range ("B"& indextable) =rstable! column_name'project Name (CH)Shttable.range ("C"& indextable) =rstable! Column_comment'KEYShttable.range ("D"& indextable) =rstable! Column_key'PropertiesShttable.range ("E"& indextable) =rstable! Column_type'MoShttable.range ("F"& indextable) =rstable! Column_default'NULLShttable.range ("G"& indextable) =rstable!is_nullable rstable.movenext indextable= Indextable +1Wend Tebleinfo=SHEETNMEnd FunctionFunctionSheetisexist (Wbcheck asWorkbook, SHTNM as String) Sheetisexist=False     on Error GoToLAB1SetShtsheet =wbcheck.sheets (SHTNM)IfShtsheet is  Nothing  Thensheetisexist=False    Elsesheetisexist=True    End If        SetShtsheet = Nothing    Exit Functionlab1:sheetisexist=FalseEnd Function

The most general implementation of the effect:

VBA to implement an existing database and get the structure of all tables