Могу ли я использовать Access VBA, чтобы определить, есть ли в таблице макрос данных?

Question

Есть ли способ определить через VBA, если таблица Access содержит макрос данных или нет? У меня есть макросы данных на самых моих таблиц, но мой код не работает, если он встречает таблицу без нее.

Я не получаю сообщение об ошибке. Вместо этого код продолжает работать, как если бы он находился в бесконечном цикле, но мне нужно заставить 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, который сначала проверяет, существует ли макрос данных в таблице. Я не уверен, как это написать.

Благодаря людям, указавшим на функции SaveAsText и LoadFromText in another SO post. Кажется, что эти функции имеют большой потенциал.

Answer 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 

Кредит относится к a post on UtterAccess и @Scotch's answer to a question on SO, которые ссылаются на сообщение UtterAccess.

Answer 2

Чтобы увидеть базу данных, содержащую макросы, вы можете использовать документальные методы из 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_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