[AccessD] Add-In Express 2009 for MS Office and .NET

Shamil,

In your Export Code below.

Error 2001 needs to be trapped and handled.  This will occur because your
code is parsing the MSys objects and if the object is  no  longer "LIVE" but
still shown in the MSys tables etc.  

.ALLFORMS will over come this I think.

Max


Option Compare Text
Option Explicit
On Error GoTo errhandler

Dim app As Access.Application
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strTargetFolder As String
Dim strTargetFileName As String
Dim strObjectFileFullPath As String
Dim strObjectName As String

    Set app = Access.Application
    
    strTargetFolder = Access.Application.CurrentProject.path + "\Objects\"
        
    Set dbs = app.CurrentDb
    Set rst = dbs.OpenRecordset(exportedObjectsSql, dbOpenForwardOnly)
    While Not (rst.EOF)
        Select Case rst![AcObjectType].Value
        Case acTable:
             strTargetFileName = _
                    rst![ObjectTypeName].Value + "_" + _
                    rst![ObjectName].Value
             If (Left(rst![ObjectName].Value, 4) <> "MSys") Then
                app.ExportXML acTable, _
                 rst![ObjectName].Value, _
                 strTargetFileName + ".xml", _
                 strTargetFileName + "Schema.xml"
             Else
                On Error Resume Next
                app.ExportXML acTable, _
                 rst![ObjectName].Value, _
                 strTargetFolder + "MSysTables\" + strTargetFileName +
".xml", _
                 strTargetFolder + "MSysTables\" + strTargetFileName +
"Schema.xml"
                On Error GoTo errhandler
             End If
        Case acQuery, _
             acForm, _
             acReport, _
             acMacro, _
             acModule:
               strTargetFileName = rst![ObjectTypeName].Value + _
                    "_" + rst![ObjectName].Value + ".txt"
               app.SaveAsText _
                 rst![AcObjectType].Value, _
                 rst![ObjectName].Value, _
                 strTargetFolder + strTargetFileName
        Case Else
        End Select
        rst.MoveNext
    Wend
    rst.Close
    
    MsgBox ("Export DONE!")
exithere:
    Exit Sub
errhandler:
    MsgBox "Unhandled Error in sExportAllObjects(): " & Err.Number & vbCrLf
& Err.Description
    Resume exithere
    
End Sub

Private Property Get exportedObjectsSql()
Dim strSql As String
    strSql = _
 "SELECT " + _
 "  Switch( " + _
 "    [Type]=1,0, " + _
 "    [Type]=5,1, " + _
 "    [Type]=-32768,2, " + _
 "    [Type]=-32764,3, " + _
 "    [Type]=-32766,4, " + _
 "    [Type]=-32761,5) AS acObjectType, " + _
 "  Choose( " + _
 "   [acObjectType]+1,'Table','Query','Form','Report','Macro','Module') AS
ObjectTypeName, " + _
 "   MSysObjects.Name as ObjectName " + _
 " FROM MSysObjects " + _
 " WHERE " + _
 "   ((Not (Switch( " + _
 "
[Type]=1,0,[Type]=5,1,[Type]=-32768,2,[Type]=-32764,3,[Type]=-32766,4,[Type]
=-32761,5)) Is Null) AND ((MSysObjects.Name) Not Like '~*')) " + _
 " ORDER BY
Switch([Type]=1,0,[Type]=5,1,[Type]=-32768,2,[Type]=-32764,3,[Type]=-32766,4
,[Type]=-32761,5), MSysObjects.Name;"
    exportedObjectsSql = strSql
End Property