Can I use Access VBA to determine if there is a data macro in the table?

Question

Is there a way to determine through VBA if the Access table contains a data macro or not? I have data macros on most of my tables, but my code does not work if it encounters a table without it.

I am not getting an error message. Instead, the code continues to run as if it were in an infinite loop, but I need to get Access to exit the game.

In particular, I am trying to save all my tables and data macros, so I can use the (undocumented) LoadFromText function to recreate them later.

I highlighted the problem in my code example below: ** BUG **.

For Each td In db.TableDefs If Left(td.Name, 4) <> "MSys" Then 'Save the table as a text file. DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".txt", True 'Save the table data macro as an XML file. '** BUG **: If a table doesn't have a data macro, Access freezes/starts infinite loop. Application.SaveAsText acTableDataMacro, td.Name, sExportLocation & "Table_" & td.Name & "_DataMacro.xml" End If Next td 

I assume that I need some kind of nested If statement, which first checks if a data macro exists in the table. I'm not sure how to write this.

Thanks to the people who pointed out the SaveAsText and LoadFromText functions in another SO post . These features seem to have great potential.

Answer 1

You can use a simple query to indicate if the table has a data macro:

 SELECT [Name] FROM MSysObjects WHERE Not IsNull(LvExtra) and Type =1 

This macro can be applied to the VBA code in the question as follows:

 For Each td In db.TableDefs If Left(td.Name, 4) <> "MSys" Then 'Save the table as a text file. DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & _ "Table_" & td.Name & ".txt", True 'Define a recordset to determine if the table has a data macro. sql = "SELECT [Name] FROM MSysObjects WHERE Not IsNull(LvExtra) and " & _ "Type = 1 and [Name] = '" & td.Name & "'" Set rst = db.OpenRecordset(sql, dbOpenSnapshot) 'If the table has a data macro, save the data macro as an XML file. If rst.RecordCount <> 0 Then Application.SaveAsText acTableDataMacro, td.Name, sExportLocation & _ "Table_" & td.Name & "_DataMacro.xml" End If 'Close the recordset and clear its variable. If Not rst Is Nothing Then rst.Close Set rst = Nothing End If End If Next td 

Credit sends a message to UtterAccess and @Scotch answers the question about SO , which refer to the UtterAccess message.

Answer 2

To see if the database contains macros or not, you can use document methods from the DAO. Here is an example from https://msdn.microsoft.com/en-us/library/office/ff191764.aspx :

 Sub ContainerObjectX() Dim dbsNorthwind As Database Dim ctrLoop As Container Dim prpLoop As Property Dim docItem As Document ' Set dbsNorthwind = OpenDatabase("Northwind.mdb") Set dbsNorthwind = CurrentDb With dbsNorthwind ' Enumerate Containers collection. For Each ctrLoop In .Containers Debug.Print "Properties of " & ctrLoop.Name _ & " container" ' Enumerate Properties collection of each ' Container object. For Each prpLoop In ctrLoop.Properties Debug.Print " " & prpLoop.Name _ & " = "; prpLoop Next prpLoop For Each docItem In ctrLoop.Documents Debug.Print " docItem.Name = "; docItem.Name Next docItem Next ctrLoop .Close End With End Sub 

So you need to check the documents in the Scripts container.

My initial answer: I think you can use ExportXML and ImportXML, it is much more powerful and able to export and import all access objects. Example:

 ExportXML acExportTable, "tblMain", CM_GetDBPath() & "AccessFunc_Tbl.xml" _ , CM_GetDBPath() & "AccessFunc_TblShema.xml", CM_GetDBPath() & "AccessFunc_Tbl.xsl" _ , "Images", , acEmbedSchema .... ImportXML CM_GetDBPath() & "AccessFunc_Tbl.xml", acAppendData 

Full example: http://5codelines.net/wp-content/uploads/xml_1_sampe.rar

You can also use the ADODB library.

 Public Function EportTblToXml(ByVal imTblFrom As String _ , ByVal imFileTo As String) Dim rstData As ADODB.Recordset Dim cnn As ADODB.Connection Set cnn = CurrentProject.Connection Set rstData = New ADODB.Recordset rstData.Open "SELECT * FROM " & imTblFrom, cnn _ , adOpenKeyset, adLockOptimistic Call SaveRstToXml(rstData, imFileTo) rstData.Close End Function Public Function LoadXmlToRst(ByVal stFileName As String) As ADODB.Recordset Dim rst As ADODB.Recordset Set rst = New ADODB.Recordset rst.Open stFileName Set LoadXmlToRst = rst End Function