Max (MGA)
max.wanadoo at gmail.com
Sat Feb 13 08:08:19 CST 2010
Hi Shamil, I will do some testing later, but on the import code you need to ensure that it doesn't try to import the same code module that it is actually running, ie assuming the code is saved with the name as show here, then If getObjectNameFromFileName(strSourceFileName) <> "modObjectsImport" Then ' run code Else ' skip code Endif -----Original Message----- From: accessd-bounces at databaseadvisors.com [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Shamil Salakhetdinov Sent: 13 February 2010 13:35 To: 'Access Developers discussion and problem solving' Subject: Re: [AccessD] Add-In Express 2009 for MS Office and .NET Hi Max -- Thank you for your note/code review. OK, I will add error 2001 handling. Anything else to consider? -- Shamil -----Original Message----- From: accessd-bounces at databaseadvisors.com [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Max Wanadoo Sent: Saturday, February 13, 2010 1:39 PM To: 'Access Developers discussion and problem solving' Subject: Re: [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 -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com __________ Information from ESET NOD32 Antivirus, version of virus signature database 4862 (20100212) __________ The message was checked by ESET NOD32 Antivirus. http://www.esetnod32.ru __________ Information from ESET NOD32 Antivirus, version of virus signature database 4862 (20100212) __________ The message was checked by ESET NOD32 Antivirus. http://www.esetnod32.ru -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com