我可以使用 Access VBA 来确定 table 是否有数据宏吗?
Can I use Access VBA to determine if a table has a Data Macro?
有没有办法通过 VBA 确定 Access table 是否包含数据宏?我的 table 中的 most 有数据宏,但如果遇到没有它的 table,我的代码就会失败。
我没有收到错误消息。相反,代码保持 运行 就好像它处于无限循环中一样,但我必须强制 Access 退出才能逃脱。
具体来说,我试图保存我的所有 table 和数据宏,以便我以后可以使用(未记录的)LoadFromText 函数重新创建它们。
我在下面的代码示例中用 ** 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
我假设我想要某种嵌套的 If 语句,它首先检查 table 中是否存在数据宏。不过我不知道怎么写。
感谢指出 SaveAsText 和 LoadFromText 函数的人们 in another SO post。这些功能看起来很有潜力。
要查看数据库是否包含宏,您可以使用 DAO 中记录的方法。这是来自 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
所以你只需要检查 "Scripts" 容器下的文件。
我原来的回答:
我认为您可以使用 ExportXML 和 ImportXML 它更强大并且能够导出和导入所有访问对象。
示例:
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
完整示例在这里:http://5codelines.net/wp-content/uploads/xml_1_sampe.rar
您也可以使用 ADODB 库。
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
您可以使用一个简单的查询来指示 table 是否具有数据宏:
SELECT [Name] FROM MSysObjects WHERE Not IsNull(LvExtra) and Type =1
这个宏可以应用于问题中的 VBA 代码,如下所示:
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
归功于引用 UtterAccess post 的 a post on UtterAccess and @Scotch's answer to a question on SO。
有没有办法通过 VBA 确定 Access table 是否包含数据宏?我的 table 中的 most 有数据宏,但如果遇到没有它的 table,我的代码就会失败。
我没有收到错误消息。相反,代码保持 运行 就好像它处于无限循环中一样,但我必须强制 Access 退出才能逃脱。
具体来说,我试图保存我的所有 table 和数据宏,以便我以后可以使用(未记录的)LoadFromText 函数重新创建它们。
我在下面的代码示例中用 ** 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
我假设我想要某种嵌套的 If 语句,它首先检查 table 中是否存在数据宏。不过我不知道怎么写。
感谢指出 SaveAsText 和 LoadFromText 函数的人们 in another SO post。这些功能看起来很有潜力。
要查看数据库是否包含宏,您可以使用 DAO 中记录的方法。这是来自 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
所以你只需要检查 "Scripts" 容器下的文件。
我原来的回答: 我认为您可以使用 ExportXML 和 ImportXML 它更强大并且能够导出和导入所有访问对象。 示例:
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
完整示例在这里:http://5codelines.net/wp-content/uploads/xml_1_sampe.rar
您也可以使用 ADODB 库。
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
您可以使用一个简单的查询来指示 table 是否具有数据宏:
SELECT [Name] FROM MSysObjects WHERE Not IsNull(LvExtra) and Type =1
这个宏可以应用于问题中的 VBA 代码,如下所示:
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
归功于引用 UtterAccess post 的 a post on UtterAccess and @Scotch's answer to a question on SO。