| 1 |
Option Compare Database |
| 2 |
Option Explicit |
| 3 |
|
| 4 |
' exportSQL version 3.0 |
| 5 |
' www.rot13.org/~dpavlin/projects.html#sql |
| 6 |
' |
| 7 |
' based on exportSQL version 2.0 from www.cynergi.net/prod/exportsql/ |
| 8 |
' |
| 9 |
' (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net |
| 10 |
' (C) Pedro Freire - pedro.freire@cynergi.net (do not add to mailing lists without permission) |
| 11 |
' (c) 2000-2001 Dobrica Pavlinusic <dpavlin@rot13.org> - added PostgreSQL support |
| 12 |
' |
| 13 |
' This code is provided free for anyone's use and is therefore without guarantee or support. |
| 14 |
' This does NOT mean CYNERGI delegates its copyright to anyone using it! You may change the |
| 15 |
' code in any way, as long as this notice remains on the code and CYNERGI is notified (if you |
| 16 |
' publish the changes: if your changes/corrections prove valuable and are added to the code, |
| 17 |
' you will be listed in a credit list on this file). |
| 18 |
' |
| 19 |
' You may NOT sell this as part of a non-free package: |
| 20 |
' IF YOU HAVE PAID FOR THIS CODE, YOU HAVE BEEN ROBBED! CONTACT admin@cynergi.net! |
| 21 |
|
| 22 |
' MODULE |
| 23 |
' "exportSQL" |
| 24 |
' |
| 25 |
' GOAL |
| 26 |
' Export all tables in a MS-Access database file to 2 text files: |
| 27 |
' one containing SQL instructions to delete the new tables to be created, |
| 28 |
' and the other with SQL instructions to create and insert data into |
| 29 |
' the new tables. The table structure and data will resemble as much as |
| 30 |
' possible the current Access database. |
| 31 |
' |
| 32 |
' HOW TO USE |
| 33 |
' Copy-and-paste this text file into an Access module and run the first |
| 34 |
' (and only public) function. in more detail, you: |
| 35 |
' * Open the Access .mdb file you wish to export |
| 36 |
' * in the default database objects window, click on "Modules", and then on "New" |
| 37 |
' * The code window that opens has some pre-written text (code). Delete it. |
| 38 |
' * Copy-and-paste this entire file to the code module window |
| 39 |
' * If you are using Microsoft Access 2000 you will have to make |
| 40 |
' one additional step: go into Tools/References and check following |
| 41 |
' component: Microsoft DAO Object 3.6 Library and uncheck Microsoft |
| 42 |
' ActiveX Data Objects Library |
| 43 |
' * You may hit the compile button (looks like 3 sheets of paper with an arrow on |
| 44 |
' top of them, pressing down on them), or select Debug, Compile Loaded Modules |
| 45 |
' from the top menu, just to make sure there are no errors, and that this code |
| 46 |
' works on your Access version (it works on Access'97 and should work on Access'95) |
| 47 |
' * Close the code module window - windows will prompt you to save the code: |
| 48 |
' answer "Yes", and when promped for a name for the module, type anything |
| 49 |
' (say, "MexportSQL") |
| 50 |
' The module is now part of your Access database. To run the export, you: |
| 51 |
' * Re-open the code module (by double-clicking on it, or clicking "Design" |
| 52 |
' with it selected). Move the cursor to where the first "Function" keyword appears. |
| 53 |
' Press F5 or select Run, Go/Continue from the top menu. |
| 54 |
' * Alternativelly, click on "Macros" on the database objects window, |
| 55 |
' and then on "New". On the macro window, select "RunCode" as the macro action, |
| 56 |
' and "exportSQL" as the function name, bellow. Save the macro similarly to the |
| 57 |
' module, and this time double-clicking on it, or clicking "Run" will run the export. |
| 58 |
' |
| 59 |
' BEFORE RUNNING THE EXPORT |
| 60 |
' Before running the export, be sure to check out the Export Options just bellow this |
| 61 |
' text, and change any according to your wishes and specs. |
| 62 |
' |
| 63 |
' TECH DATA |
| 64 |
' Public identifiers: |
| 65 |
' * Only one: "exportSQL", a function taking and returning no arguments. It runs the export. |
| 66 |
' Functionallity: |
| 67 |
' * Can export to mSQL v1, mSQL v2, MySQL or PostgreSQL recognised SQL statements |
| 68 |
' * Excellent respect for name conversion, namespace verification, type matching, etc. |
| 69 |
' * Detects default values "=Now()", "=Date()" and "=Time()" to create types like "TIMESTAMP" |
| 70 |
' * Fully configurable via private constants on top of code |
| 71 |
' * Exports two files: one for erasures, another for creations (useful when updating dbs) |
| 72 |
' * Generates compatibility warnings when necessary |
| 73 |
' * Code and generated files are paragraphed and easy to read |
| 74 |
' * Access text and memo fields can have any type of line termination: \n\r, \r\n, \n or \r |
| 75 |
' * Properly escapes text and memo fields, besides all types of binary fields |
| 76 |
' * Closes all open objects and files on error |
| 77 |
' * Known bugs / incomplete constructs are signalled with comments starting with "!!!!" |
| 78 |
' * Two alternatives on absent date/time type on mSQL: REAL or CHAR field |
| 79 |
' * Exports Primary key and Indexes for PostgreSQL |
| 80 |
' * Inserts Constrains as comments in SQL dump |
| 81 |
|
| 82 |
' Export Options - change at will |
| 83 |
|
| 84 |
Private Const DB_ENGINE As String = "Pg" ' USE ONLY "M1" (mSQL v1), "M2" (mSQL v2), "MY" (MySQL) or "Pg" (PostgreSQL) |
| 85 |
Private Const DB_NAME As String = "" ' Use empty string for current. Else use filename or DSN name of database to export |
| 86 |
Private Const DB_CONNECT As String = "" ' Used only if above string is not empty |
| 87 |
Private Const MSQL_64kb_AVG As Long = 2048 ' ALWAYS < 65536 (to be consistent with MS Access). Set to max expected size of Access MEMO field (to preserve space in mSQL v1) |
| 88 |
Private Const WS_REPLACEMENT As String = "_" ' Use "" to simply eat whitespaces in identifiers (table and field names) |
| 89 |
Private Const IDENT_MAX_SIZE As Integer = 19 ' Suggest 64. Max size of identifiers (table and field names) |
| 90 |
Private Const PREFIX_ON_KEYWORD As String = "_" ' Prefix to add to identifier, if it is a reserved word |
| 91 |
Private Const SUFFIX_ON_KEYWORD As String = "" ' Suffix to add to identifier, if it is a reserved word |
| 92 |
Private Const PREFIX_ON_INDEX As String = "ix" ' Prefix to add to index identifier, to make it unique (mSQL v2) |
| 93 |
Private Const SUFFIX_ON_INDEX As String = "" ' Suffix to add to index identifier, to make it unique (mSQL v2) |
| 94 |
Private Const ADD_SQL_FILE As String = "c:\temp\esql_add.txt" ' Use empty if open on #1. Will be overwritten if exists! |
| 95 |
Private Const DEL_SQL_FILE As String = "c:\temp\esql_del.txt" ' Use empty if open on #2. Will be overwritten if exists! |
| 96 |
Private Const LINE_BREAK As String = "\n" ' Try "<br>". String to replace line breaks in text fields |
| 97 |
Private Const COMMENTS As Boolean = True ' Dump comments into output file |
| 98 |
Private Const DISPLAY_WARNINGS As Boolean = True ' False to output the warnings to the files, only |
| 99 |
Private Const DATE_AS_STR As Boolean = True ' False to use real number data type for date, time and timestamp (in mSQL only) |
| 100 |
Private Const PARA_INSERT_AFTER As Integer = 3 ' Field count after which print INSERTs different lines |
| 101 |
Private Const INDENT_SIZE As Integer = 5 ' Number of spaces on indents |
| 102 |
|
| 103 |
|
| 104 |
' Global var to store inter-funtion data |
| 105 |
Private warnings As String ' Not an option: do not set in any way |
| 106 |
Private COMMENT_PREFIX As String |
| 107 |
Private QUERY_SEPARATOR As String ' Terminator/separator of SQL queries (to instruct some monitor program to execute them) |
| 108 |
|
| 109 |
|
| 110 |
' Primary Export Function |
| 111 |
|
| 112 |
Sub exportSQL() |
| 113 |
On Error GoTo exportSQL_error |
| 114 |
|
| 115 |
Dim cdb As Database |
| 116 |
Dim ctableix As Integer, ctablename As String |
| 117 |
If COMMENTS Then |
| 118 |
If DB_ENGINE = "Pg" Then |
| 119 |
COMMENT_PREFIX = "--" |
| 120 |
QUERY_SEPARATOR = ";" |
| 121 |
Else |
| 122 |
COMMENT_PREFIX = "#" |
| 123 |
QUERY_SEPARATOR = "\g" |
| 124 |
End If |
| 125 |
End If |
| 126 |
|
| 127 |
If DB_NAME = "" Then |
| 128 |
Set cdb = CurrentDb() |
| 129 |
Else |
| 130 |
Set cdb = OpenDatabase(DB_NAME, False, True, DB_CONNECT) ' Shared, read-only |
| 131 |
End If |
| 132 |
|
| 133 |
If ADD_SQL_FILE <> "" Then Open ADD_SQL_FILE For Output As #1 |
| 134 |
If DEL_SQL_FILE <> "" Then Open DEL_SQL_FILE For Output As #2 |
| 135 |
|
| 136 |
DoCmd.Hourglass True |
| 137 |
|
| 138 |
If COMMENTS Then |
| 139 |
Dim convert_to As String |
| 140 |
If (Left$(DB_ENGINE, 2) = "MY") Then |
| 141 |
convert_to = "MySQL" |
| 142 |
ElseIf (DB_ENGINE = "Pg") Then |
| 143 |
convert_to = "PostgreSQL" |
| 144 |
Else |
| 145 |
convert_to = "mSQL" |
| 146 |
End If |
| 147 |
Print #1, COMMENT_PREFIX & " Exported from MS Access to " & convert_to |
| 148 |
Print #2, COMMENT_PREFIX & " Exported from MS Access to " & convert_to |
| 149 |
Print #1, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net" |
| 150 |
Print #2, COMMENT_PREFIX & " (C) 1997-98 CYNERGI - www.cynergi.net, info@cynergi.net" |
| 151 |
End If |
| 152 |
|
| 153 |
'Go through the table definitions |
| 154 |
For ctableix = 0 To cdb.TableDefs.Count - 1 |
| 155 |
|
| 156 |
Dim cfieldix As Integer, cfieldname As String |
| 157 |
Dim fieldlst As String, sqlcode As String |
| 158 |
Dim primary_found As Boolean |
| 159 |
Dim crs As Recordset |
| 160 |
|
| 161 |
' Let's take only the visible tables |
| 162 |
If (((cdb.TableDefs(ctableix).Attributes And DB_SYSTEMOBJECT) Or _ |
| 163 |
(cdb.TableDefs(ctableix).Attributes And DB_HIDDENOBJECT))) = 0 Then |
| 164 |
|
| 165 |
ctablename = conv_name("" & cdb.TableDefs(ctableix).Name) |
| 166 |
|
| 167 |
Print #2, |
| 168 |
Print #2, "DROP TABLE " & ctablename & QUERY_SEPARATOR |
| 169 |
|
| 170 |
' CREATE clause |
| 171 |
Print #1, |
| 172 |
Print #1, "CREATE TABLE " & ctablename |
| 173 |
Print #1, Space$(INDENT_SIZE) & "(" |
| 174 |
|
| 175 |
warnings = "" |
| 176 |
fieldlst = "" |
| 177 |
primary_found = False |
| 178 |
|
| 179 |
' loop thorugh each field in the table |
| 180 |
For cfieldix = 0 To cdb.TableDefs(ctableix).Fields.Count - 1 |
| 181 |
|
| 182 |
Dim typestr As String, fieldsz As Integer, dvstr As String |
| 183 |
Dim found_ix As Boolean, cindex, tmpindex As Index, cfield, tmpfield As Field |
| 184 |
|
| 185 |
' if this is not the first iteration, add separators |
| 186 |
If fieldlst <> "" Then |
| 187 |
fieldlst = fieldlst & ", " |
| 188 |
Print #1, "," |
| 189 |
End If |
| 190 |
|
| 191 |
' get field name |
| 192 |
cfieldname = conv_name("" & cdb.TableDefs(ctableix).Fields(cfieldix).Name) |
| 193 |
fieldlst = fieldlst & cfieldname |
| 194 |
|
| 195 |
' translate types |
| 196 |
If DB_ENGINE = "M1" Or DB_ENGINE = "M2" Then |
| 197 |
Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type |
| 198 |
Case dbChar |
| 199 |
typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")" |
| 200 |
Case dbText |
| 201 |
fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size |
| 202 |
If fieldsz = 0 Then fieldsz = 255 |
| 203 |
typestr = "CHAR(" & fieldsz & ")" |
| 204 |
Case dbBoolean, dbByte, dbInteger, dbLong |
| 205 |
typestr = "INT" |
| 206 |
Case dbDouble, dbFloat, dbSingle |
| 207 |
typestr = "REAL" |
| 208 |
Case dbCurrency, dbDecimal, dbNumeric |
| 209 |
typestr = "REAL" |
| 210 |
warn "In new field '" & cfieldname & "', currency/BCD will be converted to REAL - there may be precision loss!", False |
| 211 |
Case dbDate |
| 212 |
typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP |
| 213 |
warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False |
| 214 |
Case dbTime |
| 215 |
typestr = IIf(DATE_AS_STR, "CHAR(8)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP |
| 216 |
warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & ".", False |
| 217 |
Case dbTimeStamp |
| 218 |
typestr = IIf(DATE_AS_STR, "CHAR(19)", "REAL") ' use Access internal format: IEEE 64-bit (8-byte) FP |
| 219 |
warn "In new field '" & cfieldname & "', date/time/timestamp will be converted to " & typestr & "." & IIf(DB_ENGINE = "M2", " Consider using pseudo field '_timestamp'.", ""), False |
| 220 |
Case dbMemo |
| 221 |
If DB_ENGINE = "M2" Then |
| 222 |
typestr = "TEXT(" & MSQL_64kb_AVG & ")" |
| 223 |
Else |
| 224 |
typestr = "CHAR(" & MSQL_64kb_AVG & ")" |
| 225 |
warn "In new field '" & cfieldname & "', dbMemo is not supported by mSQL v1 - fields larger than MSQL_64kb_AVG (" & MSQL_64kb_AVG & ") will not be accepted!", False |
| 226 |
End If |
| 227 |
Case dbBinary, dbVarBinary |
| 228 |
typestr = "CHAR(255)" |
| 229 |
warn "In new field '" & cfieldname & "', dbBinary and dbVarBinary are not supported by mSQL! - will use a text (CHAR(255)) field.", True |
| 230 |
Case dbLongBinary |
| 231 |
typestr = "CHAR(" & MSQL_64kb_AVG & ")" |
| 232 |
warn "In new field '" & cfieldname & "', dbLongBinary is not supported by mSQL! - will use a text (CHAR(" & MSQL_64kb_AVG & ")) field.", True |
| 233 |
Case Else |
| 234 |
warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True |
| 235 |
Error 5 ' invalid Procedure Call |
| 236 |
End Select |
| 237 |
ElseIf DB_ENGINE = "MY" Then |
| 238 |
Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type |
| 239 |
Case dbBinary |
| 240 |
typestr = "TINYBLOB" |
| 241 |
Case dbBoolean |
| 242 |
typestr = "TINYINT" |
| 243 |
Case dbByte |
| 244 |
typestr = "TINYINT UNSIGNED" |
| 245 |
Case dbChar |
| 246 |
typestr = "CHAR(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")" |
| 247 |
Case dbCurrency |
| 248 |
typestr = "DECIMAL(20,4)" |
| 249 |
Case dbDate |
| 250 |
typestr = "DATETIME" |
| 251 |
Case dbDecimal |
| 252 |
typestr = "DECIMAL(20,4)" |
| 253 |
Case dbDouble |
| 254 |
typestr = "REAL" |
| 255 |
Case dbFloat |
| 256 |
typestr = "REAL" |
| 257 |
Case dbInteger |
| 258 |
typestr = "SMALLINT" |
| 259 |
Case dbLong |
| 260 |
typestr = "INT" |
| 261 |
Case dbLongBinary |
| 262 |
typestr = "LONGBLOB" |
| 263 |
Case dbMemo |
| 264 |
typestr = "LONGBLOB" ' !!!!! MySQL bug! Replace by LONGTEXT when corrected! |
| 265 |
Case dbNumeric |
| 266 |
typestr = "DECIMAL(20,4)" |
| 267 |
Case dbSingle |
| 268 |
typestr = "FLOAT" |
| 269 |
Case dbText |
| 270 |
fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size |
| 271 |
If fieldsz = 0 Then fieldsz = 255 |
| 272 |
typestr = "CHAR(" & fieldsz & ")" |
| 273 |
Case dbTime |
| 274 |
typestr = "TIME" |
| 275 |
Case dbTimeStamp |
| 276 |
typestr = "TIMESTAMP" |
| 277 |
Case dbVarBinary |
| 278 |
typestr = "TINYBLOB" |
| 279 |
Case dbBigInt, dbGUID |
| 280 |
warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True |
| 281 |
Error 5 ' invalid Procedure Call |
| 282 |
Case Else |
| 283 |
typestr = "LONGBLOB" |
| 284 |
End Select |
| 285 |
ElseIf DB_ENGINE = "Pg" Then |
| 286 |
Select Case cdb.TableDefs(ctableix).Fields(cfieldix).Type |
| 287 |
Case dbBinary |
| 288 |
typestr = "int2" |
| 289 |
Case dbBoolean |
| 290 |
typestr = "bool" |
| 291 |
Case dbByte |
| 292 |
typestr = "int2" |
| 293 |
Case dbChar |
| 294 |
typestr = "varchar(" & cdb.TableDefs(ctableix).Fields(cfieldix).Size & ")" |
| 295 |
Case dbCurrency |
| 296 |
typestr = "DECIMAL(20,4)" |
| 297 |
Case dbDate |
| 298 |
typestr = "DATETIME" |
| 299 |
Case dbDecimal |
| 300 |
typestr = "DECIMAL(20,4)" |
| 301 |
Case dbDouble |
| 302 |
typestr = "float8" |
| 303 |
Case dbFloat |
| 304 |
typestr = "float4" |
| 305 |
Case dbInteger |
| 306 |
typestr = "int4" |
| 307 |
Case dbLong |
| 308 |
typestr = "int8" |
| 309 |
Case dbLongBinary |
| 310 |
typestr = "text" ' hm? |
| 311 |
Case dbMemo |
| 312 |
typestr = "text" |
| 313 |
Case dbNumeric |
| 314 |
typestr = "DECIMAL(20,4)" |
| 315 |
Case dbSingle |
| 316 |
typestr = "float4" |
| 317 |
Case dbText |
| 318 |
fieldsz = cdb.TableDefs(ctableix).Fields(cfieldix).Size |
| 319 |
If fieldsz = 0 Then fieldsz = 255 |
| 320 |
typestr = "varchar(" & fieldsz & ")" |
| 321 |
Case dbTime |
| 322 |
typestr = "TIME" |
| 323 |
Case dbTimeStamp |
| 324 |
typestr = "TIMESTAMP" |
| 325 |
Case dbVarBinary |
| 326 |
typestr = "text" ' hm? |
| 327 |
Case dbBigInt, dbGUID |
| 328 |
warn "In new field '" & cfieldname & "', dbBigInt and dbGUID are not currently supported!", True |
| 329 |
Error 5 ' invalid Procedure Call |
| 330 |
Case Else |
| 331 |
typestr = "text" |
| 332 |
End Select |
| 333 |
Else |
| 334 |
warn "unkown DB_ENGINE string " & DB_ENGINE, True |
| 335 |
Error 5 ' invalid Procedure Call |
| 336 |
End If |
| 337 |
|
| 338 |
' check not null and auto-increment properties |
| 339 |
If ((cdb.TableDefs(ctableix).Fields(cfieldix).Attributes And dbAutoIncrField) <> 0) Then |
| 340 |
If Left$(DB_ENGINE, 2) = "MY" Then |
| 341 |
typestr = typestr & " NOT NULL AUTO_INCREMENT" |
| 342 |
ElseIf DB_ENGINE = "Pg" Then |
| 343 |
typestr = " serial" |
| 344 |
Else |
| 345 |
typestr = typestr & " NOT NULL" |
| 346 |
warn "In new field '" & cfieldname & "', mSQL does not support auto-increment fields! - they will be pure INTs." & IIf(DB_ENGINE = "M2", " Consider using pseudo field '_rowid' or SEQUENCEs.", ""), False |
| 347 |
End If |
| 348 |
ElseIf cdb.TableDefs(ctableix).Fields(cfieldix).Required = True Then |
| 349 |
typestr = typestr & " NOT NULL" |
| 350 |
End If |
| 351 |
|
| 352 |
' default value |
| 353 |
dvstr = cdb.TableDefs(ctableix).Fields(cfieldix).DefaultValue |
| 354 |
If dvstr <> "" Then |
| 355 |
If Left$(DB_ENGINE, 2) <> "MY" And DB_ENGINE <> "Pg" Then |
| 356 |
warn "In new field '" & cfieldname & "', mSQL does not support default values! - they won't be initialised.", False |
| 357 |
ElseIf Left$(DB_ENGINE, 2) = "MY" And cdb.TableDefs(ctableix).Fields(cfieldix).Required = False Then |
| 358 |
warn "In new field '" & cfieldname & "', MySQL needs NOT NULL to support default values! - it won't be set a default.", False |
| 359 |
ElseIf Left$(dvstr, 1) = """" Then |
| 360 |
typestr = typestr & " DEFAULT '" & conv_str(Mid$(dvstr, 2, Len(dvstr) - 2)) & "'" |
| 361 |
ElseIf ((LCase(dvstr) = "now()" Or LCase(dvstr) = "date()" Or LCase(dvstr) = "time()") And _ |
| 362 |
(Left$(typestr, 5) = "DATE " Or Left$(typestr, 5) = "TIME " Or Left$(typestr, 9) = "DATETIME ")) Then |
| 363 |
typestr = "TIMESTAMP " & Right$(typestr, Len(typestr) - InStr(typestr, " ")) |
| 364 |
ElseIf LCase(dvstr) = "no" Then |
| 365 |
typestr = typestr & " DEFAULT 0" |
| 366 |
ElseIf LCase(dvstr) = "yes" Then |
| 367 |
typestr = typestr & " DEFAULT 1" |
| 368 |
Else |
| 369 |
typestr = typestr & " DEFAULT " & dvstr |
| 370 |
End If |
| 371 |
End If |
| 372 |
|
| 373 |
' add constrains |
| 374 |
Dim val_rule, val_text As String |
| 375 |
val_rule = cdb.TableDefs(ctableix).Fields(cfieldix).ValidationRule |
| 376 |
val_text = cdb.TableDefs(ctableix).Fields(cfieldix).ValidationText |
| 377 |
If DB_ENGINE = "Pg" And val_rule <> "" Then |
| 378 |
typestr = typestr & COMMENT_PREFIX & " check ( " & val_rule & " ) " & COMMENT_PREFIX & " " & val_text |
| 379 |
warn "Field '" & cfieldname & "' has constrain '" & val_rule & "' with text '" & val_text & "' which you have to convert manually (inserted as comment in SQL)", False |
| 380 |
End If |
| 381 |
|
| 382 |
' check if primary key (for mSQL v1) |
| 383 |
If DB_ENGINE = "M1" Then |
| 384 |
found_ix = False |
| 385 |
For Each cindex In cdb.TableDefs(ctableix).Indexes |
| 386 |
If cindex.Primary Then |
| 387 |
For Each cfield In cindex.Fields |
| 388 |
If cfield.Name = cdb.TableDefs(ctableix).Fields(cfieldix).Name Then |
| 389 |
found_ix = True |
| 390 |
Exit For |
| 391 |
End If |
| 392 |
Next cfield |
| 393 |
If found_ix Then Exit For |
| 394 |
End If |
| 395 |
Next cindex |
| 396 |
If found_ix Then |
| 397 |
If primary_found Then |
| 398 |
warn "On new table '" & ctablename & "', mSQL v1 does not support more than one PRIMARY KEY! Only first key was set.", False |
| 399 |
Else |
| 400 |
typestr = typestr & " PRIMARY KEY" |
| 401 |
primary_found = True |
| 402 |
End If |
| 403 |
End If |
| 404 |
End If |
| 405 |
|
| 406 |
'print out field info |
| 407 |
Print #1, Space$(INDENT_SIZE) & cfieldname & Space$(IDENT_MAX_SIZE - Len(cfieldname) + 2) & typestr; |
| 408 |
|
| 409 |
Next cfieldix |
| 410 |
|
| 411 |
' terminate CREATE clause |
| 412 |
If DB_ENGINE = "M2" Then |
| 413 |
Print #1, |
| 414 |
Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR |
| 415 |
End If |
| 416 |
|
| 417 |
' primary key and other index declaration |
| 418 |
If DB_ENGINE = "M2" Or Left$(DB_ENGINE, 2) = "MY" Or DB_ENGINE = "Pg" Then |
| 419 |
For Each cindex In cdb.TableDefs(ctableix).Indexes |
| 420 |
sqlcode = "" |
| 421 |
For Each cfield In cindex.Fields |
| 422 |
sqlcode = sqlcode & IIf(sqlcode = "", "", ", ") & conv_name(cfield.Name) |
| 423 |
Next cfield |
| 424 |
If DB_ENGINE = "M2" Then |
| 425 |
Print #1, "CREATE " & IIf(cindex.Unique, "UNIQUE ", "") & "INDEX " & _ |
| 426 |
conv_name(PREFIX_ON_INDEX & cindex.Name & SUFFIX_ON_INDEX) & " ON " & _ |
| 427 |
ctablename & " (" & sqlcode & ")" & QUERY_SEPARATOR |
| 428 |
ElseIf DB_ENGINE = "Pg" Then |
| 429 |
If cindex.Primary Then |
| 430 |
Print #1, "," & Chr(13) & Space$(INDENT_SIZE) & "PRIMARY KEY (" & sqlcode & ")"; |
| 431 |
ElseIf cindex.Unique Then |
| 432 |
Print #1, "," & Chr(13) & Space$(INDENT_SIZE) & "UNIQUE INDEX (" & sqlcode & ")"; |
| 433 |
Else |
| 434 |
' skip indexes which are part of primary key |
| 435 |
primary_found = False |
| 436 |
For Each tmpindex In cdb.TableDefs(ctableix).Indexes |
| 437 |
If tmpindex.Primary Then |
| 438 |
For Each tmpfield In tmpindex.Fields |
| 439 |
If sqlcode = conv_name(tmpfield.Name) Then |
| 440 |
primary_found = True |
| 441 |
Exit For |
| 442 |
End If |
| 443 |
Next tmpfield |
| 444 |
End If |
| 445 |
Next tmpindex |
| 446 |
If Not primary_found Then |
| 447 |
Print #1, "," & Chr(13) & Space$(INDENT_SIZE) & "INDEX (" & sqlcode & ")"; |
| 448 |
End If |
| 449 |
End If |
| 450 |
|
| 451 |
Else |
| 452 |
Print #1, "," |
| 453 |
Print #1, Space$(INDENT_SIZE) & IIf(cindex.Primary, "PRIMARY ", "") & _ |
| 454 |
"KEY (" & sqlcode & ")"; |
| 455 |
End If |
| 456 |
Next cindex |
| 457 |
End If |
| 458 |
|
| 459 |
' terminate CREATE clause |
| 460 |
If DB_ENGINE <> "M2" Then |
| 461 |
Print #1, |
| 462 |
Print #1, Space$(INDENT_SIZE) & ")" & QUERY_SEPARATOR |
| 463 |
End If |
| 464 |
|
| 465 |
' print any warnings bellow it |
| 466 |
If COMMENTS And warnings <> "" Then |
| 467 |
If DB_ENGINE = "M2" Then Print #1, COMMENT_PREFIX & " " |
| 468 |
Print #1, warnings |
| 469 |
warnings = "" |
| 470 |
End If |
| 471 |
|
| 472 |
Print #1, |
| 473 |
|
| 474 |
' INSERT clause |
| 475 |
Set crs = cdb.OpenRecordset(cdb.TableDefs(ctableix).Name) |
| 476 |
If crs.RecordCount <> 0 Then |
| 477 |
|
| 478 |
' loop thorugh each record in the table |
| 479 |
crs.MoveFirst |
| 480 |
Do Until crs.EOF |
| 481 |
|
| 482 |
' start paragraphing |
| 483 |
sqlcode = "INSERT INTO " & ctablename |
| 484 |
If crs.Fields.Count > PARA_INSERT_AFTER Then |
| 485 |
Print #1, sqlcode |
| 486 |
If DB_ENGINE = "M1" Then Print #1, Space$(INDENT_SIZE) & "(" & fieldlst & ")" |
| 487 |
Print #1, "VALUES (" |
| 488 |
sqlcode = Space$(INDENT_SIZE) |
| 489 |
Else |
| 490 |
If DB_ENGINE = "M1" Then sqlcode = sqlcode & " (" & fieldlst & ")" |
| 491 |
sqlcode = sqlcode & " VALUES (" |
| 492 |
End If |
| 493 |
|
| 494 |
' loop through each field in each record |
| 495 |
For cfieldix = 0 To crs.Fields.Count - 1 |
| 496 |
|
| 497 |
' based on type, prepare the field value |
| 498 |
If IsNull(crs.Fields(cfieldix).Value) Then |
| 499 |
sqlcode = sqlcode & "NULL" |
| 500 |
Else |
| 501 |
Select Case crs.Fields(cfieldix).Type |
| 502 |
Case dbBoolean |
| 503 |
sqlcode = sqlcode & IIf(crs.Fields(cfieldix).Value = True, "1", "0") |
| 504 |
Case dbChar, dbText, dbMemo |
| 505 |
sqlcode = sqlcode & "'" & conv_str(crs.Fields(cfieldix).Value) & "'" |
| 506 |
Case dbDate, dbTimeStamp |
| 507 |
If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then |
| 508 |
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "YYYY-MM-DD HH:MM:SS") & "'" |
| 509 |
Else |
| 510 |
'print in Access internal format: IEEE 64-bit (8-byte) FP |
| 511 |
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'" |
| 512 |
End If |
| 513 |
Case dbTime |
| 514 |
If Left$(DB_ENGINE, 2) = "MY" Or DATE_AS_STR Then |
| 515 |
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "HH:MM:SS") & "'" |
| 516 |
Else |
| 517 |
'print in Access internal format: IEEE 64-bit (8-byte) FP |
| 518 |
sqlcode = sqlcode & "'" & Format(crs.Fields(cfieldix).Value, "#.#########") & "'" |
| 519 |
End If |
| 520 |
Case dbBinary, dbLongBinary, dbVarBinary |
| 521 |
sqlcode = sqlcode & "'" & conv_bin(crs.Fields(cfieldix).Value) & "'" |
| 522 |
Case dbCurrency, dbDecimal, dbDouble, dbFloat, dbNumeric, dbSingle |
| 523 |
sqlcode = sqlcode & conv_float(crs.Fields(cfieldix).Value) |
| 524 |
Case Else |
| 525 |
sqlcode = sqlcode & conv_str(crs.Fields(cfieldix).Value) |
| 526 |
End Select |
| 527 |
End If |
| 528 |
|
| 529 |
' paragraph separators |
| 530 |
If cfieldix < crs.Fields.Count - 1 Then |
| 531 |
sqlcode = sqlcode & ", " |
| 532 |
If crs.Fields.Count > PARA_INSERT_AFTER Then |
| 533 |
Print #1, sqlcode |
| 534 |
sqlcode = Space$(INDENT_SIZE) |
| 535 |
End If |
| 536 |
End If |
| 537 |
|
| 538 |
Next cfieldix |
| 539 |
|
| 540 |
' print out result and any warnings |
| 541 |
sqlcode = sqlcode & IIf(crs.Fields.Count > PARA_INSERT_AFTER, " )", ")") & QUERY_SEPARATOR |
| 542 |
Print #1, sqlcode |
| 543 |
If COMMENTS And warnings <> "" Then |
| 544 |
Print #1, warnings |
| 545 |
warnings = "" |
| 546 |
End If |
| 547 |
If crs.Fields.Count > PARA_INSERT_AFTER Then Print #1, |
| 548 |
|
| 549 |
crs.MoveNext |
| 550 |
Loop |
| 551 |
|
| 552 |
Else |
| 553 |
|
| 554 |
' if there is no data on the table |
| 555 |
If COMMENTS Then Print #1, COMMENT_PREFIX & " This table has no data" |
| 556 |
|
| 557 |
End If |
| 558 |
|
| 559 |
crs.Close |
| 560 |
Set crs = Nothing |
| 561 |
|
| 562 |
End If 'print only unhidden tables |
| 563 |
|
| 564 |
Next ctableix |
| 565 |
|
| 566 |
exportSQL_exit: |
| 567 |
Close #2 |
| 568 |
Close #1 |
| 569 |
|
| 570 |
cdb.Close |
| 571 |
Set cdb = Nothing |
| 572 |
|
| 573 |
DoCmd.Hourglass False |
| 574 |
|
| 575 |
Exit Sub |
| 576 |
|
| 577 |
exportSQL_error: |
| 578 |
MsgBox Err.Description |
| 579 |
Resume exportSQL_exit |
| 580 |
|
| 581 |
End Sub |
| 582 |
|
| 583 |
|
| 584 |
Private Function conv_name(strname As String) As String |
| 585 |
Dim i As Integer, str As String |
| 586 |
|
| 587 |
' replace inner spaces with WS_REPLACEMENT |
| 588 |
str = strname |
| 589 |
i = 1 |
| 590 |
While i <= Len(str) |
| 591 |
Select Case Mid$(str, i, 1) |
| 592 |
Case " ", Chr$(9), Chr$(10), Chr$(13) ' space, tab, newline, carriage return |
| 593 |
str = Left$(str, i - 1) & WS_REPLACEMENT & Right$(str, Len(str) - i) |
| 594 |
i = i + Len(WS_REPLACEMENT) |
| 595 |
Case Else |
| 596 |
i = i + 1 |
| 597 |
End Select |
| 598 |
Wend |
| 599 |
' restrict tablename to IDENT_MAX_SIZE chars, *after* eating spaces |
| 600 |
str = Left$(str, IDENT_MAX_SIZE) |
| 601 |
' check for reserved words |
| 602 |
conv_name = str |
| 603 |
If Left$(DB_ENGINE, 2) = "MY" Then |
| 604 |
Select Case LCase$(str) |
| 605 |
Case "add", "all", "alter", "and", "as", "asc", "auto_increment", "between", _ |
| 606 |
"bigint", "binary", "blob", "both", "by", "cascade", "char", "character", _ |
| 607 |
"change", "check", "column", "columns", "create", "data", "datetime", "dec", _ |
| 608 |
"decimal", "default", "delete", "desc", "describe", "distinct", "double", _ |
| 609 |
"drop", "escaped", "enclosed", "explain", "fields", "float", "float4", _ |
| 610 |
"float8", "foreign", "from", "for", "full", "grant", "group", "having", _ |
| 611 |
"ignore", "in", "index", "infile", "insert", "int", "integer", "interval", _ |
| 612 |
"int1", "int2", "int3", "int4", "int8", "into", "is", "key", "keys", _ |
| 613 |
"leading", "like", "lines", "limit", "lock", "load", "long", "longblob", _ |
| 614 |
"longtext", "match", "mediumblob", "mediumtext", "mediumint", "middleint", _ |
| 615 |
"numeric", "not", "null", "on", "option", "optionally", "or", "order", _ |
| 616 |
"outfile", "partial", "precision", "primary", "procedure", "privileges", _ |
| 617 |
"read", "real", "references", "regexp", "repeat", "replace", "restrict", _ |
| 618 |
"rlike", "select", "set", "show", "smallint", "sql_big_tables", _ |
| 619 |
"sql_big_selects", "sql_select_limit", "straight_join", "table", "tables", _ |
| 620 |
"terminated", "tinyblob", "tinytext", "tinyint", "trailing", "to", "unique", _ |
| 621 |
"unlock", "unsigned", "update", "usage", "values", "varchar", "varying", _ |
| 622 |
"with", "write", "where", "zerofill" |
| 623 |
conv_name = Left$(PREFIX_ON_KEYWORD & str & SUFFIX_ON_KEYWORD, IDENT_MAX_SIZE) |
| 624 |
If (str = conv_name) Then |
| 625 |
warn "In identifier '" & strname & "', the new form '" & strname & _ |
| 626 |
"' is a reserved word, and PREFIX_ON_KEYWORD ('" & _ |
| 627 |
PREFIX_ON_KEYWORD & "') and SUFFIX_ON_KEYWORD ('" & SUFFIX_ON_KEYWORD & _ |
| 628 |
"') make it larger than IDENT_MAX_SIZE, and after cut it is the same as the original! " & _ |
| 629 |
"This is usually caused by a void or empty PREFIX_ON_KEYWORD.", True |
| 630 |
Error 5 ' invalid Procedure Call |
| 631 |
End If |
| 632 |
End Select |
| 633 |
End If |
| 634 |
End Function |
| 635 |
|
| 636 |
|
| 637 |
Private Function conv_str(str As String) As String |
| 638 |
Dim i As Integer, nlstr As String, rstr As Variant |
| 639 |
|
| 640 |
nlstr = "" |
| 641 |
rstr = Null |
| 642 |
i = 1 |
| 643 |
While i <= Len(str) |
| 644 |
Select Case Mid$(str, i, 1) |
| 645 |
Case Chr$(0) ' ASCII NUL |
| 646 |
nlstr = "" |
| 647 |
rstr = "\0" |
| 648 |
Case Chr$(8) ' backspace |
| 649 |
nlstr = "" |
| 650 |
rstr = "\b" |
| 651 |
Case Chr$(9) ' tab |
| 652 |
nlstr = "" |
| 653 |
rstr = "\t" |
| 654 |
Case "'" |
| 655 |
nlstr = "" |
| 656 |
rstr = "\'" |
| 657 |
Case """" |
| 658 |
nlstr = "" |
| 659 |
rstr = "\""" |
| 660 |
Case "\" |
| 661 |
nlstr = "" |
| 662 |
rstr = "\\" |
| 663 |
Case Chr$(10), Chr$(13) ' line feed and carriage return |
| 664 |
If nlstr <> "" And nlstr <> Mid$(str, i, 1) Then |
| 665 |
' there was a previous newline and this is its pair: eat it |
| 666 |
rstr = "" |
| 667 |
nlstr = "" |
| 668 |
Else |
| 669 |
' this is a fresh newline |
| 670 |
rstr = LINE_BREAK |
| 671 |
nlstr = Mid$(str, i, 1) |
| 672 |
End If |
| 673 |
Case Else |
| 674 |
nlstr = "" |
| 675 |
End Select |
| 676 |
If Not IsNull(rstr) Then |
| 677 |
str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i) |
| 678 |
i = i + Len(rstr) |
| 679 |
rstr = Null |
| 680 |
Else |
| 681 |
i = i + 1 |
| 682 |
End If |
| 683 |
Wend |
| 684 |
conv_str = str |
| 685 |
End Function |
| 686 |
|
| 687 |
|
| 688 |
Private Function conv_bin(str As String) As String |
| 689 |
Dim i As Integer, rstr As String |
| 690 |
|
| 691 |
rstr = "" |
| 692 |
i = 1 |
| 693 |
While i <= Len(str) |
| 694 |
Select Case Mid$(str, i, 1) |
| 695 |
Case Chr$(0) ' ASCII NUL |
| 696 |
rstr = "\0" |
| 697 |
Case Chr$(8) ' backspace |
| 698 |
rstr = "\b" |
| 699 |
Case Chr$(9) ' tab |
| 700 |
rstr = "\t" |
| 701 |
Case "'" |
| 702 |
rstr = "\'" |
| 703 |
Case """" |
| 704 |
rstr = "\""" |
| 705 |
Case "\" |
| 706 |
rstr = "\\" |
| 707 |
Case Chr$(10) ' line feed |
| 708 |
rstr = "\n" |
| 709 |
Case Chr$(13) ' carriage return |
| 710 |
rstr = "\r" |
| 711 |
End Select |
| 712 |
If rstr <> "" Then |
| 713 |
str = Left$(str, i - 1) & rstr & Right$(str, Len(str) - i) |
| 714 |
i = i + Len(rstr) |
| 715 |
rstr = "" |
| 716 |
Else |
| 717 |
i = i + 1 |
| 718 |
End If |
| 719 |
Wend |
| 720 |
conv_bin = str |
| 721 |
End Function |
| 722 |
|
| 723 |
' This function is used to convert local setting of decimal , to . |
| 724 |
Private Function conv_float(str As String) As String |
| 725 |
Dim i As Integer |
| 726 |
|
| 727 |
i = 1 |
| 728 |
While i <= Len(str) |
| 729 |
If Mid$(str, i, 1) = "," Then |
| 730 |
str = Left$(str, i - 1) & "." & Right$(str, Len(str) - i) |
| 731 |
End If |
| 732 |
i = i + 1 |
| 733 |
Wend |
| 734 |
conv_float = str |
| 735 |
End Function |
| 736 |
|
| 737 |
|
| 738 |
Private Sub warn(str As String, abortq As Boolean) |
| 739 |
If DISPLAY_WARNINGS Then MsgBox str, vbOKOnly Or vbExclamation, "Warning" |
| 740 |
warnings = warnings & COMMENT_PREFIX & " Warning: " & str & Chr$(13) & Chr$(10) |
| 741 |
End Sub |
| 742 |
|
Parent Directory
| 
Revision Log