3

Access テーブルにデータ マクロが含まれているかどうかを VBA で判断する方法はありますか? ほとんどのテーブルにデータ マクロがありますが、データ マクロがないテーブルに遭遇するとコードが失敗します。

エラー メッセージが表示されません。代わりに、コードは無限ループにあるかのように実行され続けますが、Access を強制的に終了してエスケープする必要があります。

具体的には、(文書化されていない) 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 ステートメントが必要であると仮定します。といっても、どう書いていいのかわかりません。

別の SO 投稿 でSaveAsText および LoadFromText 関数を指摘してくれた人々に感謝します。これらの機能には多くの可能性があるようです。

4

2 に答える 2

1

簡単なクエリを使用して、テーブルにデータ マクロがあるかどうかを示すことができます。

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 の投稿と、UtterAccess の投稿を参照した SO に関する質問に対する @Scotch の回答に記載されています。

于 2015-08-02T23:31:54.077 に答える
0

データベースにマクロが含まれているかどうかを確認するには、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

したがって、「スクリプト」コンテナの下にあるドキュメントを確認する必要があります。

私の最初の答え: 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_sample.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
于 2015-07-31T22:15:18.210 に答える