Problème avec CreateObject depuis migration vers Windows10

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!

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!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Bonjour,

votre code modifie partiellement pour connexion base access.
Pour text_SQL et l'ecriture feuille si il y, a vous de modifier

Sub Recherche_Access()
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 la base Accsess a connecter
Fichier2 = "T:\Geotechnique\Mouvements\Entrepot\BDFS\0_Sondages_a_saisir_Geotec\" & "SONDAGE.xlsx"
'Nom nom de la table Access pour la recherche
Table = "nom de la table" 'a modifier
'*******************************************************
'--- Connexion base ACCESS ---
Set Cn = CreateObject("ADODB.connection")
Set Rst = CreateObject("ADODB.Recordset")
'chaine de connexion 2007_2010_2013
connstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier2
'Connexion a la base
Cn.Open connstring
'--------- Requete a modifier suivant recherche
'... la requ?te avec WHERE et LIKE
texte_SQL = "SELECT " & Champ & " FROM " & Table & " WHERE " & Champ & " like '" & "%" & Sondage & "%';" ''" & Sondage & "%';"
Rst.Open texte_SQL, Cn, adLockOptimistic
'*******************************************************
'Table vide
If Rst.EOF And Rst.bof Then
MsgBox "Pas d'enregistrement!!!!!!!!!!!!!!!!!!!!"
Rst.Close
Cn.Close
Set Rst = Nothing
Set Cn = Nothing
Exit Sub
End If
'recup enregistrement(s)
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 ---
Rst.Close
Cn.Close
Set Rst = Nothing
Set Cn = Nothing
End Sub

Pour info:
Microsof Forms 2.0 se met automatiquement s'il y a une Userform, c'est votre cas

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.