I have the below code to transfer code modules between Access database files. I have three problems, only one of which is annoying.
a) How do you prevent the Save As box from appearing when the instance of Access is closed? I've tried the acQuitSaveAll as well as the acCmdCompileAndSaveAllModules route.
b) The On Error line was added when the code was in Access 2003, when I was getting an error message regarding a bad DLL reference when the code hit the Exit Sub at the end. The message description said to check the parameter types or values being passed. This occured consistently but the error would happen, stop the code, I'd step the code on and no error would occur, so I put a Resume Next there to step past it. Under Access 2000 however, this does not occur at all. Any ideas as to why?
c) The code does not consistently perform the import. Stepping through it appears to do what it's supposed to, and if I exit early then it prompts me to save what its done so far. However, when I let it run on a series of seven other databases, some of them don't seem to correctly do the first handful of modules. At first I thought this was to do with the Save As not appearing for those modules so it did not save them, but as a strange quirk, the more times I run this on the same files, the more modules don't get transferred. If it is not to do with the Save As box, I have a suspicion this is to do with the loops and their indexes in the components. Any suggestions?
Regards,
Rob.
Expand|Select|Wrap|Line Numbers
- Option Compare Database
- Option Explicit
- 'Stand-alone function to synchronise all files in the same directory as this one.
- Public Sub RunSynchBatch()
- Call DoBatchSynchronise(Access.Application)
- End Sub
- 'Cycles through databases in a given directory and performs a synch with this file.
- 'If sCycleDir is not supplied, you will be prompted.
- Public Sub DoBatchSynchronise(oExportFrom As Access.Application, Optional sCycleDir As String = "")
- Dim nLoop As Integer
- If sCycleDir = "" Then
- 'Sets the default entry in the prompt to the same directory as this file.
- With oExportFrom.CurrentDb
- sCycleDir = Dir(.Name, vbDirectory)
- sCycleDir = Left(.Name, Len(.Name) - Len(sCycleDir))
- End With
- sCycleDir = InputBox("Please enter the full path of the directory you wish to update:", "Update Directory", sCycleDir)
- End If
- With Application.FileSearch
- .NewSearch
- .FileType = msoFileTypeDatabases
- .LookIn = sCycleDir
- If .Execute > 0 Then
- For nLoop = 1 To .FoundFiles.Count
- 'For each database found, so long as it is not this one, transfers the code.
- If .FoundFiles(nLoop) <> oExportFrom.CurrentDb.Name Then Call DoSynchroniseCode(oExportFrom, .FoundFiles(nLoop))
- Next nLoop
- End If
- End With
- End Sub
- 'Performs a one-shot export of the code modules in the database open in the oExportFrom instance
- 'of Access to the file specified by sSendTo.
- Public Sub DoSynchroniseCode(oExportFrom As Access.Application, sSendTo As String)
- Dim oAccess As Access.Application
- Call oExportFrom.DoCmd.SetWarnings(False)
- 'Checks that the file specified is really an Access database.
- If Right(sSendTo, Len(sSendTo) - InStrRev(sSendTo, ".")) = "mdb" Then
- 'Opens a new instance of Access and opens the specified database.
- Set oAccess = New Access.Application
- Call oAccess.DoCmd.SetWarnings(False)
- Call oAccess.OpenCurrentDatabase(sSendTo)
- Call DoAccessImport(oExportFrom, oAccess)
- Call oAccess.DoCmd.RunCommand(acCmdCompileAndSaveAllModules)
- Call oAccess.Quit(acQuitSaveAll)
- End If
- Call oExportFrom.DoCmd.SetWarnings(True)
- End Sub
- 'Exports all the code files in oExportFrom and imports them into oImportTo.
- Private Sub DoAccessImport(oExportFrom As Access.Application, oImportTo As Access.Application)
- Dim sStore As String
- Dim nLoop As Integer, nComps As Integer
- 'Uses the location of the oExportFrom file to create a temporary directory to store the
- 'exported code.
- With oExportFrom.CurrentDb
- sStore = Dir(.Name, vbDirectory)
- sStore = Left(.Name, Len(.Name) - Len(sStore)) & PATH_SYNCH_DIR & "\"
- End With
- If Len(FileSystem.Dir(sStore, vbDirectory)) <= 0 Then Call FileSystem.MkDir(sStore)
- With oExportFrom.VBE
- 'For each project that exists in the database, cycles through the components which exist
- 'as part of it.
- For nLoop = 1 To .VBProjects.Count
- With .VBProjects(nLoop).VBComponents
- For nComps = 1 To .Count
- With .Item(nComps)
- 'Currently only performs this with Standard and Class modules.
- If .Type = vbext_ct_StdModule Or .Type = vbext_ct_ClassModule Then
- 'Exports the module into a text file so it can be imported.
- Call .Export(sStore & .Name & ".txt")
- Call DoImportModule(oImportTo, .Name, sStore)
- End If
- End With
- Next nComps
- End With
- Next nLoop
- End With
- End Sub
- 'Searches through the target database to check if the module being transferred already exists.
- 'If it does, then removes the module before importing the one exported from the main database.
- Private Sub DoImportModule(oSearch As Access.Application, sName As String, sStoreDir As String)
- On Error Resume Next
- Dim nLoop As Integer, nComps As Integer
- With oSearch.VBE
- 'NOTE: If you have more than one project in the target database, this will import the
- 'requested code module into all of them.
- For nLoop = 1 To .VBProjects.Count
- With .VBProjects(nLoop).VBComponents
- For nComps = 1 To .Count
- 'Checks that it has found a module of the same name, and that it is a
- 'standard or class module.
- If .Item(nComps).Name = sName And _
- (.Item(nComps).Type = vbext_ct_StdModule Or _
- .Item(nComps).Type = vbext_ct_ClassModule) Then
- 'Removes the module so that when the import is done you don't get auto-
- 'numbered versions of the module.
- Call .Remove(.Item(nComps))
- Exit For
- End If
- Next nComps
- Call .Import(sStoreDir & sName & ".txt")
- End With
- Next nLoop
- End With
- End Sub