问题
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.
回答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.
回答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
来源:https://stackoverflow.com/questions/31755802/can-i-use-access-vba-to-determine-if-a-table-has-a-data-macro