469,616 Members | 1,806 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,616 developers. It's quick & easy.

Code To Transfer VBA Modules

Hi,

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
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. 'Stand-alone function to synchronise all files in the same directory as this one.
  5. Public Sub RunSynchBatch()
  6.     Call DoBatchSynchronise(Access.Application)
  7. End Sub
  8.  
  9. 'Cycles through databases in a given directory and performs a synch with this file.
  10. 'If sCycleDir is not supplied, you will be prompted.
  11. Public Sub DoBatchSynchronise(oExportFrom As Access.Application, Optional sCycleDir As String = "")
  12.     Dim nLoop As Integer
  13.  
  14.     If sCycleDir = "" Then
  15.         'Sets the default entry in the prompt to the same directory as this file.
  16.         With oExportFrom.CurrentDb
  17.             sCycleDir = Dir(.Name, vbDirectory)
  18.             sCycleDir = Left(.Name, Len(.Name) - Len(sCycleDir))
  19.         End With
  20.  
  21.         sCycleDir = InputBox("Please enter the full path of the directory you wish to update:", "Update Directory", sCycleDir)
  22.     End If
  23.  
  24.     With Application.FileSearch
  25.         .NewSearch
  26.         .FileType = msoFileTypeDatabases
  27.         .LookIn = sCycleDir
  28.  
  29.         If .Execute > 0 Then
  30.             For nLoop = 1 To .FoundFiles.Count
  31.                 'For each database found, so long as it is not this one, transfers the code.
  32.                 If .FoundFiles(nLoop) <> oExportFrom.CurrentDb.Name Then Call DoSynchroniseCode(oExportFrom, .FoundFiles(nLoop))
  33.             Next nLoop
  34.         End If
  35.     End With
  36. End Sub
  37.  
  38. 'Performs a one-shot export of the code modules in the database open in the oExportFrom instance
  39. 'of Access to the file specified by sSendTo.
  40. Public Sub DoSynchroniseCode(oExportFrom As Access.Application, sSendTo As String)
  41.     Dim oAccess As Access.Application
  42.  
  43.     Call oExportFrom.DoCmd.SetWarnings(False)
  44.  
  45.     'Checks that the file specified is really an Access database.
  46.     If Right(sSendTo, Len(sSendTo) - InStrRev(sSendTo, ".")) = "mdb" Then
  47.         'Opens a new instance of Access and opens the specified database.
  48.         Set oAccess = New Access.Application
  49.  
  50.         Call oAccess.DoCmd.SetWarnings(False)
  51.         Call oAccess.OpenCurrentDatabase(sSendTo)
  52.         Call DoAccessImport(oExportFrom, oAccess)
  53.         Call oAccess.DoCmd.RunCommand(acCmdCompileAndSaveAllModules)
  54.         Call oAccess.Quit(acQuitSaveAll)
  55.     End If
  56.  
  57.     Call oExportFrom.DoCmd.SetWarnings(True)
  58. End Sub
  59.  
  60. 'Exports all the code files in oExportFrom and imports them into oImportTo.
  61. Private Sub DoAccessImport(oExportFrom As Access.Application, oImportTo As Access.Application)
  62.     Dim sStore As String
  63.     Dim nLoop As Integer, nComps As Integer
  64.  
  65.     'Uses the location of the oExportFrom file to create a temporary directory to store the
  66.     'exported code.
  67.     With oExportFrom.CurrentDb
  68.         sStore = Dir(.Name, vbDirectory)
  69.         sStore = Left(.Name, Len(.Name) - Len(sStore)) & PATH_SYNCH_DIR & "\"
  70.     End With
  71.  
  72.     If Len(FileSystem.Dir(sStore, vbDirectory)) <= 0 Then Call FileSystem.MkDir(sStore)
  73.  
  74.     With oExportFrom.VBE
  75.         'For each project that exists in the database, cycles through the components which exist
  76.         'as part of it.
  77.         For nLoop = 1 To .VBProjects.Count
  78.             With .VBProjects(nLoop).VBComponents
  79.                 For nComps = 1 To .Count
  80.                     With .Item(nComps)
  81.                         'Currently only performs this with Standard and Class modules.
  82.                         If .Type = vbext_ct_StdModule Or .Type = vbext_ct_ClassModule Then
  83.                             'Exports the module into a text file so it can be imported.
  84.                             Call .Export(sStore & .Name & ".txt")
  85.                             Call DoImportModule(oImportTo, .Name, sStore)
  86.                         End If
  87.                     End With
  88.                 Next nComps
  89.             End With
  90.         Next nLoop
  91.     End With
  92. End Sub
  93.  
  94. 'Searches through the target database to check if the module being transferred already exists.
  95. 'If it does, then removes the module before importing the one exported from the main database.
  96. Private Sub DoImportModule(oSearch As Access.Application, sName As String, sStoreDir As String)
  97.     On Error Resume Next
  98.  
  99.     Dim nLoop As Integer, nComps As Integer
  100.  
  101.     With oSearch.VBE
  102.         'NOTE: If you have more than one project in the target database, this will import the
  103.         'requested code module into all of them.
  104.         For nLoop = 1 To .VBProjects.Count
  105.             With .VBProjects(nLoop).VBComponents
  106.                 For nComps = 1 To .Count
  107.                     'Checks that it has found a module of the same name, and that it is a
  108.                     'standard or class module.
  109.                     If .Item(nComps).Name = sName And _
  110.                        (.Item(nComps).Type = vbext_ct_StdModule Or _
  111.                         .Item(nComps).Type = vbext_ct_ClassModule) Then
  112.                         'Removes the module so that when the import is done you don't get auto-
  113.                         'numbered versions of the module.
  114.                         Call .Remove(.Item(nComps))
  115.                         Exit For
  116.                     End If
  117.                 Next nComps
  118.  
  119.                 Call .Import(sStoreDir & sName & ".txt")
  120.             End With
  121.         Next nLoop
  122.     End With
  123. End Sub
  124.  
Jul 3 '07 #1
0 1415

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

3 posts views Thread by joieva | last post: by
5 posts views Thread by Glauco | last post: by
242 posts views Thread by James Cameron | last post: by
17 posts views Thread by Lauren Wilson | last post: by
6 posts views Thread by Shaun Wilde | last post: by
2 posts views Thread by Bart Van der Donck | last post: by
1 post views Thread by Saurabh | last post: by
reply views Thread by gheharukoh7 | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.