Public Sub MakeMySQLBackup(ODBCBaseName As String, ByVal sBackupFile As String, Optional ByVal StatusBar As Boolean = False)
Dim oConn As ADODB.Connection
Dim BaseMakeBackup As Recordset
Dim BaseMakeBackupCreate As Recordset
Dim DataBaseTables As Recordset
Dim d As Integer
Dim ZeilenString As String
Dim TabellenName As String
Dim DatenString As String
Dim ViewString As String
Dim DateiNR As Integer
Dim Felder As String
Dim Insert As String
Dim Counter As Long
Dim Pfad As String
Dim Tabellenanzahl As Long
Dim TabellenCounter As Long
Dim ZeilenCounter As Long
'Pfad anlegen
Pfad = ExtraktPfad(sBackupFile)
VerzeichnisAnlegen Pfad, False
' Backup-Datei öffnen
DateiNR = 1
Open sBackupFile For Output As DateiNR
'Statusbar setzen
If StatusBar = True Then
setStatusBar 1, "MySql: Datenbackverbindung herstellen", , 0, 3000
End If
' Verbindung zur MySQL-Datenbank herstellen
Set oConn = New Connection
Set BaseMakeBackup = New ADODB.Recordset
Set BaseMakeBackupCreate = New ADODB.Recordset
Set DataBaseTables = New ADODB.Recordset
oConn.Open "Provider=MSDASQL;DSN=" & ODBCBaseName
'Kopfdaten schreiben
Print #DateiNR, "-- MySQL VBA dump 1.0"
Print #DateiNR, "--"
Print #DateiNR, "-- ------------------------------------------------------"
Print #DateiNR, "-- Server version " & oConn.Properties.Item("DBMS Version")
Print #DateiNR, ""
Print #DateiNR, ""
Print #DateiNR, "/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;"
Print #DateiNR, "/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;"
Print #DateiNR, "/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;"
Print #DateiNR, "/*!40101 SET NAMES utf8 */;"
Print #DateiNR, ""
Print #DateiNR, "/*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;"
Print #DateiNR, "/*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;"
Print #DateiNR, "/*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;"
Print #DateiNR, ""
Print #DateiNR, ""
Print #DateiNR, "--"
Print #DateiNR, "-- Create schema " & oConn.DefaultDatabase
Print #DateiNR, "--"
Print #DateiNR, ""
Print #DateiNR, "CREATE DATABASE IF NOT EXISTS `" & oConn.DefaultDatabase & "`;"
Print #DateiNR, "USE `" & oConn.DefaultDatabase & ";"
Print #DateiNR, ""
' alle Tabellen ermitteln
TabellenName = ""
With DataBaseTables
.Open "SHOW FULL TABLES", oConn
'temporäre Tabellen für Views schreiben
Do While Not .EOF
Tabellenanzahl = Tabellenanzahl + 1
If .Fields.Item("Table_type").Value = "VIEW" Then
TabellenName = .Fields.Item(0).Value
Print #DateiNR, "--"
Print #DateiNR, "-- Temporary table structure for view `" & UTF8_Encode(TabellenName) & "`"
Print #DateiNR, "--"
Print #DateiNR, "DROP TABLE IF EXISTS `" & UTF8_Encode(TabellenName) & "`;"
Print #DateiNR, "DROP VIEW IF EXISTS `" & UTF8_Encode(TabellenName) & "`;"
With BaseMakeBackupCreate
.Open "SHOW FIELDS FROM `" & TabellenName & "`", oConn
' SQL-Anweisungen zur Erstellung der jeweiligen
' Tabelle in die Textdatei schreiben
ZeilenStringCreate = "CREATE TABLE `" & UTF8_Encode(TabellenName) & "` ("
Print #DateiNR, ZeilenStringCreate
Do While Not .EOF
MySQLField = UTF8_Encode(.Fields.Item(0).Value)
MySQLType = .Fields.Item(1).Value
ZeilenStringCreate = " `" & MySQLField & "` " & MySQLType
' nächstes Feld
.MoveNext
If .EOF = False Then
ZeilenStringCreate = ZeilenStringCreate & ","
End If
Print #DateiNR, ZeilenStringCreate
Loop
.Close
Print #DateiNR, ");"
Print #DateiNR, ""
End With
End If
.MoveNext
Loop
.Close
'Tabellen und Views schreiben
.Open "SHOW FULL TABLES", oConn
Do While Not .EOF
TabellenName = .Fields.Item(0).Value
TabellenCounter = TabellenCounter + 1
If .Fields.Item("Table_type").Value = "BASE TABLE" Then
'Tabelle
'Statusbar setzen
If StatusBar = True Then
setStatusBar TabellenCounter, "MySql: Tabelle '" & TabellenName & "'", , 0, Tabellenanzahl
End If
' Datei-Information
Print #DateiNR, ""
Print #DateiNR, "--"
Print #DateiNR, "-- Definition of table `" & UTF8_Encode(TabellenName) & "`"
Print #DateiNR, "--"
Print #DateiNR, ""
' SQL-Anweisungen zur Erstellung der jeweiligen
' Tabelle in die Textdatei schreiben
Print #DateiNR, "DROP TABLE IF EXISTS `" & UTF8_Encode(TabellenName) & "`;"
With BaseMakeBackupCreate
.Open "SHOW CREATE TABLE `" & TabellenName & "`", oConn
Print #DateiNR, UTF8_Encode(Replace(.Fields.Item("Create Table").Value, "CREATE TABLE", "CREATE TABLE IF NOT EXISTS")) & ";"
.Close
End With
' SQL-Anweisungen zur Speichern der Datensätzen der
' jeweiligen Tabelle in die Textdatei
With BaseMakeBackup
.Open "SELECT * FROM `" & TabellenName & "`", oConn
Print #DateiNR, ""
Print #DateiNR, "--"
Print #DateiNR, "-- Dumping data for table `" & UTF8_Encode(TabellenName) & "`"
Print #DateiNR, "--"
Print #DateiNR, ""
'Felder Speichern
With BaseMakeBackupCreate
.Open "SHOW FIELDS FROM `" & TabellenName & "`", oConn
Felder = ""
Do While Not .EOF
MySQLField = UTF8_Encode(.Fields.Item(0).Value)
If Felder <> "" Then
Felder = Felder & ","
End If
Felder = Felder & "`" & MySQLField & "`"
.MoveNext
Loop
.Close
End With
Print #DateiNR, "/*!40000 ALTER TABLE `" & UTF8_Encode(TabellenName) & "` DISABLE KEYS */;"
ZeilenCounter = 0
If .EOF = False Then
Insert = "INSERT INTO `" & UTF8_Encode(TabellenName) & "` (" & Felder & ") VALUES"
Print #DateiNR, Insert
Counter = MaxQueryLength
Do While Not .EOF
'Statusbar setzen
ZeilenCounter = ZeilenCounter + 1
If StatusBar = True And ZeilenCounter Mod 250 = 0 Then
setStatusBar TabellenCounter, "MySql: Tabelle '" & TabellenName & "' [Datensatz #" & ZeilenCounter & "]", , 0, Tabellenanzahl
End If
ZeilenString = "("
For d = 0 To .Fields.Count - 1
DatenString = Nz(.Fields.Item(d).Value)
' Currency-Feld: Komma durch Punkt ersetzen
If .Fields.Item(d).type = 131 Then
DatenString = Replace(format$(DatenString, "0.00"), ",", ".")
End If
' Backslash durch Doppel-Backslash ersetzen
DatenString = Replace(DatenString, "\", "\\")
' Hochkomma durch Backslash+Hochkomma ersetzen
DatenString = Replace(DatenString, "'", "\'")
' CR durch \r\n ersetzen
DatenString = Replace(DatenString, Chr(13), "\r\n")
DatenString = Replace(DatenString, Chr(10), "")
'utf8 codieren
DatenString = UTF8_Encode(DatenString)
ZeilenString = ZeilenString & "'" & DatenString & "',"
Next d
ZeilenString = Left(ZeilenString, Len(ZeilenString) - 1) & ")"
' zum nächsten Datensatz
.MoveNext
Counter = Counter - Len(ZeilenString)
If Counter <= 0 Then
ZeilenString = ZeilenString & ";"
If Not .EOF Then
ZeilenString = ZeilenString & vbCrLf
ZeilenString = ZeilenString & Insert
Counter = MaxQueryLength
End If
Else
If Not .EOF Then
ZeilenString = ZeilenString & ","
Else
ZeilenString = ZeilenString & ";"
End If
End If
Print #DateiNR, ZeilenString
Loop
End If
.Close
End With
' zur nächste Tabelle
Print #DateiNR, "/*!40000 ALTER TABLE `" & UTF8_Encode(TabellenName) & "` ENABLE KEYS */;"
Print #DateiNR, "----------------------------------------------"
Else
'Abfrage (View)
'Statusbar setzen
If StatusBar = True Then
setStatusBar TabellenCounter, "MySql: Abfrage '" & TabellenName & "'", , 0, Tabellenanzahl
End If
' Datei-Information
ViewString = ViewString & vbCrLf & ""
ViewString = ViewString & vbCrLf & "--"
ViewString = ViewString & vbCrLf & "-- Definition of view `" & UTF8_Encode(TabellenName) & "`"
ViewString = ViewString & vbCrLf & "--"
ViewString = ViewString & vbCrLf & ""
' SQL-Anweisungen zur Erstellung der jeweiligen
' Tabelle in die Textdatei schreiben
ViewString = ViewString & vbCrLf & "DROP TABLE IF EXISTS `" & UTF8_Encode(TabellenName) & "`;"
ViewString = ViewString & vbCrLf & "DROP VIEW IF EXISTS `" & UTF8_Encode(TabellenName) & "`;"
With BaseMakeBackupCreate
.Open "SHOW CREATE VIEW `" & TabellenName & "`", oConn
ViewString = ViewString & vbCrLf & UTF8_Encode(.Fields.Item("Create View").Value) & ";"
.Close
End With
End If
.MoveNext
Loop
.Close
'Functionen sichern
.Open "SHOW FUNCTION STATUS", oConn
Do While Not .EOF
TabellenName = .Fields.Item("Name").Value
With BaseMakeBackupCreate
.Open "SHOW CREATE FUNCTION `" & TabellenName & "`", oConn
If Nz(.Fields.Item("Create Function").Value) <> "" Then
Print #DateiNR, ""
Print #DateiNR, "--"
Print #DateiNR, "-- Definition of function `" & UTF8_Encode(TabellenName) & "`"
Print #DateiNR, "--"
Print #DateiNR, ""
Print #DateiNR, "DROP FUNCTION IF EXISTS `" & UTF8_Encode(TabellenName) & "`;"
Print #DateiNR, ""
Print #DateiNR, "DELIMITER $$"
Print #DateiNR, ""
Print #DateiNR, "/*!50003 SET @TEMP_SQL_MODE=@@SQL_MODE, SQL_MODE='STRICT_TRANS_TABLES,NO_AUTO_CREATE_USER,NO_ENGINE_SUBSTITUTION' */ $$"
Print #DateiNR, UTF8_Encode(Nz(.Fields.Item("Create Function").Value)) & " $$"
Print #DateiNR, "/*!50003 SET SESSION SQL_MODE=@TEMP_SQL_MODE */ $$"
Print #DateiNR, ""
Print #DateiNR, "DELIMITER ;"
End If
.Close
End With
.MoveNext
Loop
.Close
'Prozeduren sichern
.Open "SHOW PROCEDURE STATUS", oConn
Do While Not .EOF
TabellenName = .Fields.Item("Name").Value
With BaseMakeBackupCreate
.Open "SHOW CREATE PROCEDURE `" & TabellenName & "`", oConn
If Nz(.Fields.Item("Create Procedure").Value) <> "" Then
Print #DateiNR, ""
Print #DateiNR, "--"
Print #DateiNR, "-- Definition of procedure `" & UTF8_Encode(TabellenName) & "`"
Print #DateiNR, "--"
Print #DateiNR, ""
Print #DateiNR, "DROP PROCEDURE IF EXISTS `" & UTF8_Encode(TabellenName) & "`;"
Print #DateiNR, ""
Print #DateiNR, "DELIMITER $$"
Print #DateiNR, ""
Print #DateiNR, "/*!50003 SET @TEMP_SQL_MODE=@@SQL_MODE, SQL_MODE='STRICT_TRANS_TABLES,NO_AUTO_CREATE_USER,NO_ENGINE_SUBSTITUTION' */ $$"
Print #DateiNR, UTF8_Encode(Nz(.Fields.Item("Create Procedure").Value)) & " $$"
Print #DateiNR, "/*!50003 SET SESSION SQL_MODE=@TEMP_SQL_MODE */ $$"
Print #DateiNR, ""
Print #DateiNR, "DELIMITER ;"
End If
.Close
End With
.MoveNext
Loop
.Close
'View in Datei schreiben
If ViewString <> "" Then
Print #DateiNR, ViewString
End If
End With
oConn.Close
'Abschluss schreiben
Print #DateiNR, ""
Print #DateiNR, ""
Print #DateiNR, ""
Print #DateiNR, "/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;"
Print #DateiNR, "/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;"
Print #DateiNR, "/*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;"
Print #DateiNR, "/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;"
Print #DateiNR, "/*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;"
Print #DateiNR, "/*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;"
Print #DateiNR, "/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;"
Close
End Sub