{"id":1667,"date":"2019-09-03T16:15:45","date_gmt":"2019-09-03T23:15:45","guid":{"rendered":"https:\/\/doubleecpu.com\/?page_id=1667"},"modified":"2019-09-03T16:16:21","modified_gmt":"2019-09-03T23:16:21","slug":"record-table-structure","status":"publish","type":"page","link":"https:\/\/doubleecpu.com\/index.php\/microsoft\/visual-basic-for-applications\/record-table-structure\/","title":{"rendered":"Record Table Structure"},"content":{"rendered":"\n<pre class=\"wp-block-preformatted\">'Class For Recording\n\nVERSION 1.0 CLASS\n BEGIN\n   MultiUse = -1  'True\n END\n Attribute VB_Name = \"Record_Table_Structure\"\n Attribute VB_GlobalNameSpace = False\n Attribute VB_Creatable = False\n Attribute VB_PredeclaredId = False\n Attribute VB_Exposed = False\n Option Compare Database\n Option Explicit\n ' Date: 09\/03\/2019\n ' Author: Gilbert Medel\n ' Current Version: 3.1.0\n ' Notes: This will record the table structure of the Access file selected\n ' Needs a reference to the Access.Application object Can be expanded to capture more properties\/attributes\n '\n ' Public Variables\n '  Objects\n Public Parent As Object\n Public Self As Object\n Public Result As Integer\n '\n ' Private Variables\n '  Objects\n Private Access_Application As Object 'Application\n Private Current_File As Object 'Database\n Private Design_File As Object 'Database\n Private Table_Design_Records As Object 'Recordset2\n Private Table_List_Records As Object 'Recordset2\n Private Table_from_list As Object 'TableDef\n Private Table_Field As Object 'Field2\n '  Variables\n Private Table_List_Key As Variant\n Private Table_Design_Key As Variant\n '\n '  Initialize\n Private Sub Class_Initialize()\n End Sub\n '\n ' Public Properties\n '\n ' Public Functions\n '\n ' Public Sub\n Public Sub Record_Table_Data(Parent_Reference As Object)\n     If Parent_Reference Is Nothing Then\n         MsgBox \"No Parent Application Reference\", vbCritical, \"Record_Table_Structure\"\n         Result = 1 'No parent Error\n     Else\n         Set Parent = Parent_Reference\n         'If Variables are set Get Table Structure\n         If Set_Variables And Open_Design_Database Then\n             Generate_Table_List\n             Table_Design_Records.Close\n             Table_List_Records.Close\n             Result = 0 'No Errors\n         Else\n              Result = 2 'Data Error\n         End If\n     End If\n End Sub\n '\n ' Private Functions\n Private Function Tables_Exist() As Boolean\n     Dim Tables_Found(1) As Boolean\n     If Current_File Is Nothing Then\n         Tables_Exist = False\n     Else\n         For Each Table_from_list In Current_File.TableDefs\n             If Table_from_list.Name = \"Table_List\" Then\n                 Tables_Found(0) = True\n             End If\n             If Table_from_list.Name = \"Table_Design\" Then\n                 Tables_Found(1) = True\n             End If\n         Next Table_from_list\n     End If\n     If Tables_Found(0) Then\n         'Exists\n     Else\n         'Create table\n         Set Table_from_list = Nothing\n         Set Table_from_list = Current_File.CreateTableDef(\"Table_List\")\n         'Create Local_ID as Auto incrementing primary key\n         Set Table_Field = Table_from_list.CreateField(\"Local_ID\", DB_LONG)\n         Table_Field.Attributes = DB_AUTOINCRFIELD\n         Table_from_list.Fields.Append Table_Field\n         Set Table_List_Key = Table_from_list.CreateIndex(\"Table_ID\")\n         Table_List_Key.Primary = True\n         Set Table_Field = Table_List_Key.CreateField(\"Local_ID\")\n         Table_List_Key.Fields.Append Table_Field\n         Table_from_list.Indexes.Append Table_List_Key\n <code>    Set Table_Field = Table_from_list.CreateField(\"Table_Name\", DB_TEXT, 255)     Table_from_list.Fields.Append Table_Field     Set Table_Field = Table_from_list.CreateField(\"Version\", DB_TEXT, 255)     Table_from_list.Fields.Append Table_Field     Set Table_Field = Table_from_list.CreateField(\"Date_Updated\", DB_Date)     Table_from_list.Fields.Append Table_Field     Set Table_Field = Table_from_list.CreateField(\"Date_Created\", DB_Date)     Table_from_list.Fields.Append Table_Field     Current_File.TableDefs.Append Table_from_list End If Current_File.TableDefs.Refresh If Tables_Found(1) Then     'Exists Else     'Create table     Set Table_from_list = Current_File.CreateTableDef(\"Table_Design\")     'Create Local_ID as Auto incrementing primary key     Set Table_Field = Table_from_list.CreateField(\"Local_ID\", DB_LONG)     Table_Field.Attributes = DB_AUTOINCRFIELD     Table_from_list.Fields.Append Table_Field     Set Table_List_Key = Table_from_list.CreateIndex(\"Table_ID\")     Table_List_Key.Primary = True     Set Table_Field = Table_List_Key.CreateField(\"Local_ID\")     Table_List_Key.Fields.Append Table_Field     Table_from_list.Indexes.Append Table_List_Key     Set Table_Field = Table_from_list.CreateField(\"Table_List_FKEY\", DB_LONG)     Table_from_list.Fields.Append Table_Field     Set Table_Field = Table_from_list.CreateField(\"Field_Name\", DB_TEXT, 255)     Table_from_list.Fields.Append Table_Field     Set Table_Field = Table_from_list.CreateField(\"Data_Type\", DB_TEXT, 255)     Table_from_list.Fields.Append Table_Field      Set Table_Field = Table_from_list.CreateField(\"Date_Updated\", DB_Date)     Table_from_list.Fields.Append Table_Field      Set Table_Field = Table_from_list.CreateField(\"Date_Created\", DB_Date)     Table_from_list.Fields.Append Table_Field     Current_File.TableDefs.Append Table_from_list End If Current_File.TableDefs.Refresh Tables_Exist = True<\/code>\n End Function\n Private Function Set_Variables() As Boolean\n     Set_Variables = False\n     If Parent.Application.Name = \"Microsoft Access\" Then\n         Set Access_Application = Parent.Application\n         Set Current_File = Parent.Application.CurrentDb\n        'Set Recordset to store Design\n         If Tables_Exist Then\n             Set Table_List_Records = Current_File.TableDefs(\"Table_List\").OpenRecordset\n             Set Table_Design_Records = Current_File.TableDefs(\"Table_Design\").OpenRecordset\n             Set_Variables = True\n         Else\n             Set_Variables = False\n         End If\n     End If\n End Function\n Private Function Open_Design_Database() As Boolean\n     Dim Select_File As Object\n     Set Select_File = Access_Application.FileDialog(3) '3 File Selection dialog\n     With Select_File\n         .AllowMultiSelect = False\n         '.Application\n         '.ButtonName = Folder\n         '.Creator\n         '.DialogType\n         .Filters.Clear\n         .Filters.Add \"All Files\", \"<em>.<\/em>\"\n         .FilterIndex = 1\n         '.InitialView\n         '.Item\n         '.Parent\n         '.SelectedItems\n         .Title = \"Select File For Processing\"\n         .Show\n         If .SelectedItems.Count = 1 Then\n             If Right(.SelectedItems(1), 5) = \"accdb\" Then\n                 Set Design_File = Access_Application.DBEngine.OpenDatabase(.SelectedItems(1))\n                 Open_Design_Database = True\n             Else\n                 Open_Design_Database = False\n             End If\n         Else\n             Open_Design_Database = False\n         End If\n     End With\n End Function\n Private Function Is_Not_TID_Field(Field_Name As Variant) As Boolean\n     If Field_Name = \"Date_Created\" Or Field_Name = \"Data_Lock\" Or Field_Name = \"Date_Locked\" Or Field_Name = \"Date_Updated\" Or Field_Name = \"Data_Matched\" Or Field_Name = \"Data_Exported\" Or Field_Name = \"Local_ID\" Or Field_Name = \"Network_PKEY\" Then\n         Is_Not_TID_Field = False\n     Else\n         Is_Not_TID_Field = True\n     End If\n End Function\n '\n ' Private Subs\n Private Sub Zeroize()\n     'Clear objects\n     Set Parent = Nothing\n     Set Self = Nothing\n     Set Access_Application = Nothing\n     Set Current_File = Nothing\n     Set Design_File = Nothing\n     Set Table_from_list = Nothing\n     Set Table_Field = Nothing\n     Set Table_Design_Records = Nothing\n     Set Table_List_Records = Nothing\n     ' Clear Variables\n     Table_List_Key = Null\n     Table_Design_Key = Null\n End Sub\n Private Sub Generate_Table_List()\n     For Each Table_from_list In Design_File.TableDefs\n         'check if table is not a access application table, temp table, paste error, error table\n         If Left(Table_from_list.Name, 4) &lt;> \"MSys\" And Left(Table_from_list.Name, 2) &lt;> \"~T\" And Left(Table_from_list.Name, 4) &lt;> \"Past\" And Left(Table_from_list.Name, 3) &lt;> \"Err\" Then\n             'Checks if table is already listed\n             If IsNull(DLookup(\"Table_Name\", \"Table_List\", \"Table_Name = \" &amp; Chr(39) &amp; Table_from_list.Name &amp; Chr(39) &amp; \" AND Version = \" &amp; Chr(39) &amp; Design_File.Properties(\"AppTitle\") &amp; Chr(39))) Then\n                 Table_List_Records.AddNew\n                 Table_List_Records.Fields(\"Table_Name\") = Table_from_list.Name\n                 Table_List_Records.Fields(\"Version\") = Design_File.Properties(\"AppTitle\")\n                 Table_List_Records.Fields(\"Date_Updated\") = Now\n                 Generate_Field_List\n                 Table_List_Records.Update\n            Else\n                 'No Update Needed\n             End If\n         End If\n     Next Table_from_list\n End Sub\n Private Sub Generate_Field_List()\n     'Send Name\n     For Each Table_Field In Table_from_list.Fields\n         'Recor Field Name if not a TID Design Field\n         If Is_Not_TID_Field(Table_Field.Name) Then\n             Table_Design_Records.AddNew\n             Table_Design_Records.Fields(\"Table_List_FKEY\") = Table_List_Records.Fields(\"Local_ID\")\n             Table_Design_Records.Fields(\"Field_Name\") = Table_Field.Name\n             Table_Design_Records.Fields(\"Data_Type\") = DLookup(\"DAO_Name\", \"DataTypeEnumeration_DAO\", \"Enumeration = \" &amp; Table_Field.Type)\n             Table_Design_Records.Fields(\"Date_Updated\") = Now\n             Table_Design_Records.Update\n         End If\n     Next Table_Field\n End Sub\n '\n ' Terminate\n Private Sub Class_Terminate()\n     Zeroize\n End Sub\n '\n ' End Code<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>&#8216;Class For Recording VERSION 1.0 CLASS BEGIN MultiUse = -1 &#8216;True END Attribute VB_Name = &#8220;Record_Table_Structure&#8221; Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Compare Database Option Explicit &#8216; Date: 09\/03\/2019 &#8216; Author: Gilbert Medel &#8216; Current Version: 3.1.0 &#8216; Notes: This will record the table &hellip; <\/p>\n<p class=\"link-more\"><a href=\"https:\/\/doubleecpu.com\/index.php\/microsoft\/visual-basic-for-applications\/record-table-structure\/\" class=\"more-link\">Read more<span class=\"screen-reader-text\"> &#8220;Record Table Structure&#8221;<\/span><\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"parent":591,"menu_order":4,"comment_status":"closed","ping_status":"closed","template":"","meta":{"footnotes":""},"class_list":["post-1667","page","type-page","status-publish","hentry"],"featured_media_urls":[],"_links":{"self":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages\/1667","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/comments?post=1667"}],"version-history":[{"count":0,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages\/1667\/revisions"}],"up":[{"embeddable":true,"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/pages\/591"}],"wp:attachment":[{"href":"https:\/\/doubleecpu.com\/index.php\/wp-json\/wp\/v2\/media?parent=1667"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}