[VBA ACCESS] Erreur 7866 sous ACCESS 2003 Fermé

Question

Bonjour, 
[VBA ACCESS] Erreur 7866 sous ACCESS 2003
j'ai une petit problème et je pense que c'est lié a access 2003.
Mon code semble propre et nous plantons sur la ligne :  

msapp.OpenCurrentDatabase wstr_chemin_bases & wstr_nom_base
avec erreur de droit ??? N° 7866;

Ci dessous tout le code qui marchait en 2002.
Merci de votre aide.

Function import_tables_recycles()

Dim wobj_wk As Workspace
Dim wobj_db As Database
Dim wobj_tb_foreign As TableDef
Dim wobj_tb As TableDef
Dim msapp As Access.Application
Dim wstr_chemin_bases As String
Dim wstr_nom_base As String
Dim wstr_user As String
Dim wstr_extension As String
Dim wstr_entite As String
Dim wstr_application As String


Set wobj_wk = DBEngine.Workspaces(0)
Set wobj_db = wobj_wk.Databases(0)

delete_table

Set msapp = CreateObject("Access.application")

wstr_user = Environ("username")

wstr_chemin_bases = "C:\Documents and Settings\" & wstr_user & "\Transco\bases\"
wstr_extension = "*.mdb"

wstr_nom_base = Dir(wstr_chemin_bases & wstr_extension)
If Left(wstr_nom_base, 5) <> "Contr" Then
    Do Until wstr_nom_base = ""
        wstr_application = Left(wstr_nom_base, 3)
        msapp.OpenCurrentDatabase wstr_chemin_bases & wstr_nom_base
'accObject.OpenCurrentDatabase RepData & NameBD, True, P***W
        For Each wobj_tb_foreign In msapp.CurrentDb.TableDefs
            If Left(wobj_tb_foreign.Name, 3) = "MSI" And Mid(wobj_tb_foreign.Name, 8, 1) = "R" Then
                wstr_entite = Mid(wobj_tb_foreign.Name, 4, 3)
                Select Case Mid(wobj_tb_foreign.Name, 10, 3)
                Case "CTR"
                    wstr_table_locale = wstr_application & "_" & Left(wobj_tb_foreign.Name, 14)
                    DoCmd.TransferDatabase acLink, "Microsoft Access", wstr_chemin_bases & wstr_nom_base, acTable, wobj_tb_foreign.Name, wstr_table_locale
                Case "LIE"
                    wstr_table_locale = wstr_application & "_" & Left(wobj_tb_foreign.Name, 12)
                    DoCmd.TransferDatabase acLink, "Microsoft Access", wstr_chemin_bases & wstr_nom_base, acTable, wobj_tb_foreign.Name, wstr_table_locale
                Case "MON"
                    wstr_table_locale = wstr_application & "_" & Left(wobj_tb_foreign.Name, 12)
                    DoCmd.TransferDatabase acLink, "Microsoft Access", wstr_chemin_bases & wstr_nom_base, acTable, wobj_tb_foreign.Name, wstr_table_locale
                End Select
            End If
        Next wobj_tb_foreign
        msapp.CloseCurrentDatabase
        wstr_nom_base = Dir
    Loop
End If



End Function




Configuration: Windows XP / Internet Explorer 6.0

Utilisateur anonyme · Answer

Bonjour,  

J'ai testé votre code sous l'environnement Access 2002 (XP) et  
sous Access 2003 et il fonctionne très bien. J'ai ajouté quelques  
lignes pour tester que j'étais bien connecté, mais le tout me semble  
fonctionner, le problème doit se trouver ailleurs !  

L'usager a-t-il les droits de lecture dans ce répertoire ?  
La(es) base(s) est(sont)-elle(s) présente(s) dans ce dossier ?  
Est-que la base contenant ce code est dans le même dossier ?  
Ce code est écrit à partir de quel fichier ?  


Option Compare Database 
Option Explicit 

Sub import_tables_recycles() 

    Const MoteurDeRecherche = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" 

    Dim msapp As Access.Application 
    Dim wstr_chemin_bases As String 
    Dim wstr_nom_base As String 
    Dim wstr_user As String 
    Dim wstr_extension As String 
    Dim wstr_entite As String 
    Dim wstr_application As String 
    Dim wrs_recordset As Recordset 
    Dim objConnexion As Object 
    Dim NomFicComplet As String 

'    Set wobj_wk = DBEngine.Workspaces(0) 
'    Set wobj_db = wobj_wk.Databases(0) 
'    delete_table 

    Set msapp = CreateObject("Access.application") 
    wstr_user = Environ("username") 
    wstr_chemin_bases = "C:\Documents and Settings\" & wstr_user & "\Transco\bases\" 
    wstr_extension = "*.mdb" 
    wstr_nom_base = Dir(wstr_chemin_bases & wstr_extension) 
     
    Set objConnexion = CreateObject("ADODB.Connection") 
    NomFicComplet = MoteurDeRecherche & wstr_chemin_bases & wstr_nom_base 
    objConnexion.Open NomFicComplet 
    msapp.OpenCurrentDatabase wstr_chemin_bases & wstr_nom_base 
     
    Set wrs_recordset = New Recordset 
     
    wrs_recordset.Open "SELECT * FROM TableVideo", objConnexion, adOpenStatic, adLockOptimistic 
         
    MsgBox wrs_recordset("Cassette").Value 
    
    wrs_recordset.Close
    msapp.CloseCurrentDatabase 

    Set wrs_recordset = Nothing 
    Set objConnexion = Nothing 
    Set msapp = Nothing 

End Sub 
' 



Cdt  

Lupin

[VBA ACCESS] Erreur 7866 sous ACCESS 2003

1 réponse

Discussions similaires