Can I use Access VBA to determine if a table has a Data Macro?

Question

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

I don't receive an error message. Instead, the code keeps running as if it is in an infinite loop, but I have to force Access to quit to escape.

Specifically, I'm trying to save all of my tables and the data macros so I can use the (undocumented) LoadFromText function to recreate them later.

I've highlighted the problem in my code sample, below, with ** 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's 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 want some sort of nested If statement that first checks if a data macro exists in the table. I'm not sure how to write that, though.

Thanks to the folks who pointed out the SaveAsText and LoadFromText functions in another SO post. These functions seem to have a lot of potential.

Answer 1

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

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

This macro could 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 goes to a post on UtterAccess and @Scotch's answer to a question on SO that referenced the UtterAccess post.

Answer 2

To see is database contain macros or not you can use documented methods from DAO. Here is modified 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 just you need check documents under "Scripts" container.

My original answer: I think you can use ExportXML and ImportXML it much more powerful and able do 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 is here: http://5codelines.net/wp-content/uploads/xml_1_sampe.rar

Also you can use 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