vba判断mysql表是否存在_VBA来实现已存在的数据库，取得所有表的结构

傷城~ 2022-10-26 14:07 26阅读 0赞

‘----------------mysqlからテーブル一覧出力---------------------------

Private SubgetMysqlDbTeble\_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 AsWorksheetSet 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 AsWorkbookSet wb =Workbooks.Open(fiStr)Dim sht As Object

Set sht = wb.Sheets("テーブル一覧")

sht.Range("A3:D" & sht.UsedRange.Rows.Count) = ""

‘MySql接続

Dim conn AsADODB.ConnectionDim rs AsADODB.RecordsetSet conn = NewADODB.ConnectionSet rs = NewADODB.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 connStrSet rs =conn.Execute(sqlStr)Dim index 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‘テーブル定義情報

Dim shtName 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:Set rs = Nothingconn.Close:Set conn = Nothingwb.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 AsADODB.RecordsetSet rsTable = NewADODB.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 ThensheetNm= Right(tableNm, 31)ElsesheetNm=tableNmEnd If

‘シート名存在チェック

Dim flag As Booleanflag=SheetIsExist(wbTable, sheetNm)If flag ThenApplication.DisplayAlerts= False

‘シート名存在したら、削除

wbTable.Sheets(sheetNm).Delete

Application.DisplayAlerts= True

End IfActiveSheet.Name=sheetNmDim shtTable As Object

Set shtTable =ActiveSheet

shtTable.Range("C2") =tableNm