Problème avec CreateObject depuis migration vers Windows10 [Résolu]

Signaler
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
-
bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
-
Bonjour,

Voici la partie de mon code qui cause problème. La macro arrête à la ligne
.open
Set Cn = CreateObject("ADODB.connection")
        With Cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
             & Fichier2 & ";Extended Properties=""Excel 12.0;HDR=YES;"""
            .Open
        End With

Cette macro me sert à ouvrir et faire une recherche dans une base fermée Access à partir d'un fichier Excel. Je sais que ça vient de la ligne Provider que je dois changer, mais par quoi??

Pour le moment, j'ai seulement installer le moteur de base de données Microsoft Acces 2010.

7 réponses

Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Re,

Ben, pas de probleme avec 2010 et ref mini:

bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020

Bonjour,

J'ai modifié mes références pour qu'elles soit comme les vôtres et ça fonctionne maintenant.

En espérant, que ça reste comme ça!

Merci beaucoup pour votre aide!
Messages postés
6491
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 janvier 2020
440
Bonjour,

comme ceci:

 'Vous devez préalablement activer la référence Microsoft ActiveX Data Objects x.x Library pour utiliser les exemples présentés dans ce tutoriel.
  
    Dim Cn As ADODB.Connection
  
    Set Cn = New ADODB.Connection
    
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & chemin & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With


Voilà
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Bonjour a vous deux,

ouvrir et faire une recherche dans une base fermée Access à partir d'un fichier Excel.
Y a un bleme, car le code fait une connexion avec un fichier Excel!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
> f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

Bonjour,

Effectivement, mon erreur! C'est une table d'une base Access qui à été exporter en fichier Excel.
cs_Le Pivert
Messages postés
6491
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 janvier 2020
440
Essaie cela:

'https://silkyroad.developpez.com/VBA/ClasseursFermes/
'https://silkyroad.developpez.com/VBA/ClasseursFermes/#LV
   'Nécéssite d'activer la référence Microsoft ADO ext x.x for DLL and Security
   'Vous devez préalablement activer la référence Microsoft ActiveX Data Objects x.x Library pour utiliser les exemples présentés dans ce tutoriel.
  Sub RequeteClasseurFerme(ByVal chemin As String)
    Dim Cn As ADODB.Connection
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim oCat As ADOX.Catalog
    Dim Resultat As String
    Dim Feuille As ADOX.Table
    
    Set Cn = New ADODB.Connection
    Set oCat = New ADOX.Catalog
    
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & chemin & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    
    Set oCat.ActiveConnection = Cn
        
    For Each Feuille In oCat.Tables
        Resultat = Feuille.Name
    Next
    
    'Nom de la feuille dans le classeur fermé
    NomFeuille = Resultat
    
    'Définit la requête.
    '/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & NomFeuille & "]"
    
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
    
    'Ecrit le résultat de la requête dans la cellule A1
    Range("A1").CopyFromRecordset Rst
    
    '--- Fermeture connexion ---
     Set Feuille = Nothing
    Set oCat = Nothing
    Cn.Close
    Set Cn = Nothing
End Sub

'pour lancer:

 RequeteClasseurFerme("chemin de classeur")



@+ Le Pivert
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020

Bonjour,

J'ai essayé et ça ne fonctionne pas, Excel ferme tout seul.

J'ai utilisé le "Microsoft ActiveX Data Objetcts 2.0 Library"

Merci,
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Bonjour,

Je code comme ceci:

Sub Connexion_Base_Access()
Dim conn As Object

On Error GoTo fin

Chemin_Base = ThisWorkbook.Path 'a adapter
Set conn = CreateObject("ADODB.Connection")
'chaine de connexion 2007_2010_2013
Nom_Bases = "azerty.accdb" 'a adapter
connstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chemin_Base & "\" & Nom_Bases
'Connexion a la base
conn.Open connstring
Exit Sub
fin:
MsgBox "Erreur de connection base!!!! " & vbNewLine & "Prevenir Administrateur"
End Sub

Avce ces ref ici 15->2013, le common control n'a rien a voir. Pas besoin d'une ref ADO




Pour CCM:
Peux plus mettre les balises de code !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
> f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

Je n'y arrive toujours pas!

Qu'est-ce que le "nom_base" signifie?

J'ai envoyé mon code complet plus bas.
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020

Voici mon code original complet. Il est dans le module1 de ma feuille et est appelé par une macro qui se trouve dans un Userform.
Public T_NT As String
Sub Recherche_Classeur_Ferme()
    Dim Cn As Object
    Dim Rst As Object 'Comparaison des deux fichiers
    Dim Fichier2, texte_SQL As String
    Dim NomFeuille As String
        '-----------------------------
        
        With Worksheets(1)
            Sondage = ActiveSheet.Cells(2, 1).Value
            '.Range("A3:A100000").ClearContents
        End With
        'Définit le classeur fermé servant de base de données
        Fichier2 = "T:\Geotechnique\Mouvements\Entrepot\BDFS\0_Sondages_a_saisir_Geotec\" & "SONDAGE.xlsx" 
        'Nom de la feuille dans le classeur fermé
        Table = "SONDAGE" & "$"
        plage = "B1:B100000"
        Champ = "NO_SONDAGE"
        '--- Connexion ---
        Set Cn = CreateObject("ADODB.connection")
        With Cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
             & Fichier2 & ";Extended Properties=""Excel 12.0;HDR=YES;"""
            .Open
        End With
        '-----------------
        '... la requête avec WHERE et LIKE
        texte_SQL = "SELECT " & Champ & " FROM [" & Table & "] WHERE " & Champ & " like '" & "%" & Sondage & "%';" ''" & Sondage & "%';"
        Set Rst = CreateObject("ADODB.Recordset")
        Rst.Open texte_SQL, Cn, adOpenStatic
        'Ecriture dans la feuille de calcul
        If Not Rst.EOF Then
            ActiveSheet.Cells(2, 1).CopyFromRecordset Rst
            Rst.MoveFirst
            tsondage = Rst.GetRows
            Nb = UBound(tsondage, 2)
            If Nb > 0 Then
                TS = "["
                For NS = 0 To Nb: TS = TS & tsondage(0, NS) & " ¤ ": Next NS
                    If NS >= 2 Then
                        UserForm3.Show
                    Else
                        TS = Left(TS, Len(TS) - 3) & "]"
                        T_NT = T_NT & vbNewLine & Sondage & " en " & Nb + 1 & " exemplaires " & vbNewLine & TS
                    End If
            End If
        Else
            'Infos non trouvees
            T_NT = T_NT & vbNewLine & Sondage
        End If
        '--- Fermeture connexion ---
End Sub
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210 > f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

Re,

Ben votre code marche tres bien!!!!
W10 et Excel 2013

Pensez a la fermeture de Rst et Cn , puis le set nothing en fin de procedure

Public T_NT As String
Sub Recherche_Classeur_Ferme()
Dim Cn As Object
Dim Rst As Object 'Comparaison des deux fichiers
Dim Fichier2, texte_SQL As String
Dim NomFeuille As String
'-----------------------------

With Worksheets(1)
Sondage = ActiveSheet.Cells(2, 1).Value
'.Range("A3:A100000").ClearContents
End With
'test avec un de mes classeurs OK
'Fichier2 = "C:\_Docs_Prog_Excel\_Mashk\Excel_Excel\Sources.xlsx"
'Sondage = "Radar"
'Table = "Sources$" '
'Champ = "Infraction"
'Nom de la feuille dans le classeur ferm?
'------------------------
'D?finit le classeur ferm? servant de base de donn?es
Fichier2 = "T:\Geotechnique\Mouvements\Entrepot\BDFS\0_Sondages_a_saisir_Geotec\" & "SONDAGE.xlsx"
Table = "SONDAGE$"
Plage = "B1:B100000"
Champ = "NO_SONDAGE"
'--- Connexion ---
Set Cn = CreateObject("ADODB.connection")
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Fichier2 & ";Extended Properties=""Excel 12.0;HDR=YES;"""
.Open
End With
'-----------------
'... la requ?te avec WHERE et LIKE
texte_SQL = "SELECT " & Champ & " FROM [" & Table & "] WHERE " & Champ & " like '" & "%" & Sondage & "%';" ''" & Sondage & "%';"
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open texte_SQL, Cn, adOpenStatic
'Ecriture dans la feuille de calcul
If Not Rst.EOF Then
ActiveSheet.Cells(2, 1).CopyFromRecordset Rst
Rst.MoveFirst
tsondage = Rst.GetRows
Nb = UBound(tsondage, 2)
If Nb > 0 Then
TS = "["
For NS = 0 To Nb: TS = TS & tsondage(0, NS) & " ? ": Next NS
If NS >= 2 Then
UserForm3.Show
Else
TS = Left(TS, Len(TS) - 3) & "]"
T_NT = T_NT & vbNewLine & Sondage & " en " & Nb + 1 & " exemplaires " & vbNewLine & TS
End If
End If
Else
'Infos non trouvees
T_NT = T_NT & vbNewLine & Sondage
End If
'--- Fermeture connexion ---
End Sub


CCM: peux toujours pas mettre les balises de code!!!!!
bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
> f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

De mon côté, ça ne fonctionne toujours pas!

Est-ce qu'il y a un module ou plug-in que je doit installé?

Je viens de changer de poste de travail pour un poste plus récent. Mon ancien poste était sur Windows7 et maintenant le nouveau poste est sur Windows10.

Comment je fait pour fermer le Rst et Cn , puis le set nothing en fin de procedure. Ce n'est pas moi qui ais écrit ce code.

Merci!
bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
> bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020

Voici le code d'erreur:
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210 > f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

Bonjour,

si marche toujours pas, quelle est l'erreur????

Pouvez faire une image des refs
bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
> f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

Bonjour,

J'ai mis l'image du code d'erreur le 20 décembre (commentaire #14).

Merci!
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020

Bonjour,

J'ai réglé mon problème, j'ai été dans les références et j'ai ajouter "Microsoft ActiveX Data Objets (Multi-dimensional) 6.0 library" et "Microsoft Jet and Replication Objects 2.6 Library" et ça fonctionne maintenant.
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020

Bonjour,

Je ne sais pas ce qui c'est passé, mais le problème est revenu aujourd'hui après avoir redémarré mon poste.

J'ai vérifié et les références sont toujours là!


Merci!
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Bonjour et meilleurs voeux,

J'utilise uniquement ce que je vous ai mis en image post 5!!
Je vais vous chercher dans mon capharnaüm un fichier que j'ai code.
f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210 > f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

Re,

fichier code et fichier source a lire: https://mon-partage.fr/f/dpykFocQ/

A tester, j'ai Excel2013 vous Excel 2010.
bassmart
Messages postés
263
Date d'inscription
jeudi 19 février 2015
Statut
Membre
Dernière intervention
10 janvier 2020
> f894009
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020

Bonjour,

J'ai le même problème avec votre macro, elle bloque sur la ligne ".open".

Voici le message:
Messages postés
14952
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 janvier 2020
1 210
Bonjour,

Je vais provisoirement installer office 2010 pour voir ce qui ce passe!!
Afin de savoir si problème office ou ......