Question : Setting references in a new Access 2003 database using VBA

Hello,

I'm trying to set the references in a new Access 2003 using VBA. I'm a kind of copying the references from an existing db to the new one

The code is executed but no references are added in the new database.

I'm using this code

Can someone help me out with this?

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

           
           
             Dim cat As New ADOX.Catalog
Set cat = CreateObject("ADOX.Catalog")

Dim fileName As String
fileName = "C:\NewMDB.mdb"

cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Jet OLEDB:Engine Type=5" & _
    ";Data Source=" & fileName

Dim ref As Reference
Dim appl As New Access.Application    
appl.OpenCurrentDatabase "C:\NewMDB.mdb", True
appl.RefreshDatabaseWindow

On Error Resume Next

For Each ref In Me.Application.References
	appl.References.Item (ref.Name)	
	If Err.Number <> 0 Then		
		appl.References.AddFromFile ref.FullPath
	End If
	Err.Number = 0
Next ref
appl.RefreshDatabaseWindow
appl.CloseCurrentDatabase

           
         

Open in New Window

Select All

Answer : Setting references in a new Access 2003 database using VBA

The narrative below and attached code are from the tips page of www.aadconsulting.com and explains why your code s problematic.
_________________________________________________
Fool-proof Way to Add a Library Reference
Those of you who develop Access add-ins or library databases, know that adding a reference to the addin or library database to the user .mdb (i.e. the CurrentDb)can be tricky, as the library file may not be where it is expected to be.

I use the following function, which is called each time the library file is loaded and uses the Name property of the CodeDb (being the library file opened by code in the CurrentDb) function to return the full path of the library file:

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

           
           
             Private Function aad_AddLibraryReference() As Boolean
On Error GoTo AddLibraryReferenceError

Dim aad_refBuilderLibrary As Reference

Set aad_refBuilderLibrary = References.AddFromFile(CodeDb.Name)

aad_AddLibraryReference = True

Exit Function

AddLibraryReferenceError:

If Err = 32813 Then 'Reference already exists
   Resume Next
Else
   MsgBox "Add LibraryDB Reference Error" & Err & ". " & Err.Description  
   aad_AddLibraryReference = False
   Exit Function
End If

End Function
           
         

Open in New Window

Select All