Macro qui exporte chaque tableau d’un classeur en SQL.
- Les noms de tableau servent de nom de table
- Les colonnes commençant par 1 sont considérées comme INTEGER avec AUTOINCREMENT
- les dates sont formatées en aaaa-mm-jj
- Les apostrophes des cellules sont « échappées »
- les cellules vides sont mise à Null
- L’export se fait en UTF-8
'*******************
'Exporte les données en sql
'vers la fenêtre d'exécution (debug.print)
'les noms des tableaux servent de nom de table
'pas les noms de feuilles
'si une colonne commence par 1
'on suppose qu'il s'agit d'une clé primaire avec autoincrement
'*******************
Sub exportSQL()
'les deux parties du sql (déclaration des tables, valeurs à insérer)
Dim sql_tb, sql_val, auto_inc, data_type As String
'chr(34) = guillemet
'chaque feuille du classeur
For Each ws In ActiveWorkbook.Sheets
'chaque tableau de la feuille
For Each tb In ws.ListObjects
'sauter pdl
If tb.Name = "Tableau6" Then Exit For
auto_inc = ""
sql_tb = sql_tb & vbCrLf & "CREATE TABLE IF NOT EXISTS " & Chr(34) & tb.Name & Chr(34) & "(" & vbCrLf
'chaque colonne du tableau
For Each c In tb.ListColumns
'*** partie Déclaration des tables
'on détecte une clé primaire à autoincrémenter
If c.Range(2) = 1 Then auto_inc = vbTab & "PRIMARY KEY(" & Chr(34) & c.Name & Chr(34) & " AUTOINCREMENT)" & vbCrLf
'on évite de mettre une virgule après la dernière colonne
If estDernière(c) = True And auto_inc = "" Then sep = "" Else sep = ","
'on définit le type de donnée à déclarer
If IsDate(c.Range(2)) Then
data_type = "DATETIME"
ElseIf c.Range(2) = 1 Then
data_type = "INTEGER"
ElseIf IsNumeric(c.Range(2)) Then
data_type = "NUMERIC"
Else
data_type = "TEXT"
End If
sql_tb = sql_tb & vbTab & Chr(34) & c.Name & Chr(34) & " " & data_type & sep & vbCrLf
Next c
sql_tb = sql_tb & auto_inc & ");" & vbCrLf
If tb.ListRows.Count = 0 Then Exit For
'*** partie valeurs à insérer
sql_val = sql_val & vbCrLf & "INSERT INTO " & tb.Name & " VALUES" & vbCrLf
For Each r In tb.ListRows
sql_val = sql_val & "("
For i = 1 To tb.ListColumns.Count
'si c'est la dernière colonne on mettra une virgule
If i = tb.ListColumns.Count Then sep = "" Else sep = ","
'on met des apostrophes autour des dates et du texte
If IsDate(r.Range(i)) = True Or Not IsNumeric(r.Range(i)) Then apo = "'" Else apo = ""
'on met les dates en format
If IsDate(r.Range(i)) Then myval = Format(r.Range(i), "yyyy-mm-dd") Else myval = r.Range(i).Value
If r.Range(i) = "" Then myval = "Null"
'on échappe les apostrophes du texte
If InStr(myval, "'") > 0 Then myval = Replace(myval, "'", "''")
sql_val = sql_val & apo & myval & apo & sep
Next i
If r.Index = tb.ListRows.Count Then sep = "" Else sep = ","
sql_val = sql_val & ")" & sep & vbCrLf
Next r
sql_val = sql_val & ";"
Next tb
Next ws
'on définit un fichier de destination
'gardé en mémoire tant que le fichier est ouvert
Static destPath As String
'si l
If destPath = "" Then
With Application.FileDialog(msoFileDialogFilePicker)
.Show
destPath = .SelectedItems(1)
End With
End If
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
fsT.WriteText sql_tb & vbCrLf & sql_val
fsT.SaveToFile destPath, 2 'Save binary data To disk
msgbox "Export terminé avec succès!"
End Sub
Function estDernière(ByVal c As ListColumn) As String
If c.Index = c.Parent.ListColumns.Count Then
estDernière = True
Else
estDernière = False
End If
End Function