daily pastebin goal
26%
SHARE
TWEET

MS-Access to MySQL relationship generator

a guest Feb 9th, 2014 291 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ' 2014-02-09 - Seamus Casey
  2. '
  3. ' a modification to Ivan's handy Access to MySQL relationship/constraint generator:
  4. ' http://en.latindevelopers.com/ivancp/2012/ms-access-to-mysql-with-relationships/
  5. '
  6. ' changes include:
  7. '  1) skip Access system tables (TableDefAttributeEnum.dbSystemObjec)
  8. '  2) add support for cascading updates/deletes
  9. '
  10. 'Put this function in new/existing MS-Access module.
  11. Public Sub printRelations()
  12.     Dim sql, fk As String
  13.     Dim I, J As Integer
  14.     Dim db As Database
  15.     Dim Table As TableDef
  16.     Dim TableName As String
  17.    
  18.     ' grab a reference to this once, otherwise when we retrieve a table below,
  19.    ' we will get an 'Object Invalid or No Longer Set' error.
  20.    Set db = CurrentDb
  21.    
  22.     For I = 0 To db.Relations.Count - 1
  23.    
  24.         Set Table = db.TableDefs.Item(db.Relations(I).Table)
  25.        
  26.         If ((Table.Attributes And TableDefAttributeEnum.dbSystemObject) = 0) Then
  27.            
  28.            sql = "ALTER TABLE `" & db.Relations(I).ForeignTable & _
  29.                "` ADD CONSTRAINT `" & db.Relations(I).Name & "` FOREIGN KEY ("
  30.            fk = "("
  31.            For J = 0 To db.Relations(I).Fields.Count - 1
  32.                sql = sql & "`" & db.Relations(I).Fields(J).ForeignName & "` ,"
  33.                fk = fk & "`" & db.Relations(I).Fields(J).Name & "` ,"
  34.            Next J
  35.    
  36.            sql = Left(sql, Len(sql) - 1)
  37.            fk = Left(fk, Len(fk) - 1)
  38.            fk = fk & ")"
  39.            sql = sql & ") REFERENCES `" & db.Relations(I).Table & "`" & fk
  40.            
  41.            If (db.Relations(I).Attributes And RelationAttributeEnum.dbRelationUpdateCascade) Then
  42.                sql = sql & " ON UPDATE CASCADE"
  43.            End If
  44.            
  45.            If (db.Relations(I).Attributes And RelationAttributeEnum.dbRelationDeleteCascade) Then
  46.                sql = sql & " ON DELETE CASCADE"
  47.            End If
  48.            
  49.            sql = sql & ";"
  50.    
  51.            Debug.Print sql
  52.         End If
  53.     Next I
  54. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top