Méthode ADODB.Connection

Bonjour à tous,

je cherche à réaliser une macro qui viendrait copier une sélection d'un fichier B pour venir la coller dans un fichier A.

• Les deux fichiers sont rangés dans le même dossier. Mais ce dossier ne sera pas forcément toujours le même. L'instruction donnée aux opérateurs pour utiliser cette macro sera "placer les deux fichiers dans le même dossier".
• Je ne connais qu'une partie du nom du fichier B. En effet, le fichier B portera un nom du type Rapport_XXXXX, la seule constante sera donc "rapport".

Je suis parti sur la methode ADODB. J'ai pu rajouter la librairie via les outils.

En revanche j'ai un message d'erreur :

Erreur d'exécution '-2147467259 (80004005)':
Erreur Automation
Erreur non spécifiée

Sub copier()

    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A2:AO20000"
      'Pour une plage de cellules, utilisez:
      'Cellule = "A4:C10"

    Feuille = "feuil1$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = "C:\rapportB.xlsx"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"

    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With

    Set Rst = New ADODB.Recordset
    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic

    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")

    Range("A2").CopyFromRecordset Rst

    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing

End Sub

Avez-vous une idée ?

Bonjour,

Pourquoi ne pas utiliser Power Query

A+

Alors je ne connais pas du tout.

Pourquoi pas si vous pensez que cela pourrait convenir.

Le but de ma macro est quand même de créer un bouton pour mes collaborateurs qui viendrait chercher des données dans des fichiers.

bonjour,

Si quelqu'un a une réponse à la question (au lieu de proposer PQ) je suis intéressé aussi... Je recherche tout type de lien permettant de faire des reherches et me documenter (me former sur ce sujet. (Je connais déjà SQL et ACCESS)

Comme le titre du fil est plutôt "ouvert" je pense qu'on me répondre brièvement ici sinon merci de le faire en MP/

Merci.

A+

Bonjour le fil, Galopin01 ;-)

Galopin01 si je peux t'aider, ce sera avec grand plaisir
Perso lorsque je veux ouvrir des fichier Excel ".xlsx" en ADODB, voici ce que j'utilise

1) Dans un module en variables publiques

' Variables pour Connexion ADODB
Public Cnn As Object, Rs As Object
Public sConn As String
' adOpenForwardOnly = 0 ' Ne semble pas fonctionner !?
' adOpenStatic = 3
Public Const CursorType = 3

2) Pour connecter la base

Sub Connect_xls(sPathBdD As String)
  Set Cnn = CreateObject("ADODB.Connection")
  Cnn.provider = "MSDASQL"
  Cnn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
           "DBQ=" & sPathBdD & "; ReadOnly=False;"
End Sub

3) Pour ouvrir le RecordSet

Option Explicit
' Flag d'erreur de connexion
Dim FlgErrCon As Boolean

Sub OuvrirRs(sPathBdD As String, sTable As String, Optional sCrit As String, Optional vCrit As String)
  Dim sRqt As String, sCond As String, Sql As String
  ' En cas d'erreur
  On Error GoTo Erreur_Proc
  FlgErrCon = False
  ' Connecter la BdD
  Call Connect_xls(sPathBdD)
  ' En cas d'erreur message d'information à l'utilisateur
  If FlgErrCon = True Then
    MsgBox "Impossible de se connecter à la base de données !", vbCritical, "OUPS..."
    Cnn.Close: Set Cnn = Nothing
    End
  End If
  ' Préparer la requête
  If InStr(1, sTable, " ") > 0 Then
    Sql = "SELECT * FROM ['" & sTable & "$']"
  Else
    Sql = "SELECT * FROM [" & sTable & "$]"
  End If
  ' Vérifier si critère présent
  If Not IsMissing(sCrit) Then
    ' Définir la condition
    sCond = "WHERE " & sCrit & "='" & vCrit & "';"
    ' Créer la syntaxe de la requête
    sRqt = Sql & " " & sCond
  End If
  ' Créer un nouveau Recordset et l'ouvrir
  Set Rs = CreateObject("ADODB.Recordset")
  Rs.Open sRqt, Cnn, CursorType
  Exit Sub

Erreur_Proc:
  'LogError Err, "Sub OuvrirRs(sPathBdD=" & sPathBdD & ", sTable=" & sTable & ", sCrit=" & sCrit & ", vCrit=" & vCrit & ")"
  FlgErrCon = True  ' Mettre le FLAG d'erreur de connexion à vrai
  Resume Next
End Sub

4) L'appel pour une BdD d'équipe avec une feuille nommée "PERSONNEL" et un colonne avec entête "NOM_Prénom"

 ' Ouvrir le Recordset pour l'équipe
  Call OuvrirRs(sPath & sBdD, "PERSONNEL", "NOM_Prénom", NomChef)

Il ne reste plus qu'à parcourir le Rs (RecordSet)

Si cela peut aider aussi ceux qui passeront par ici

A+

Finalement je crois que je vais ouvrir un sujet plus complet...

Merci.

A+

Pour l'instant je n'arrive pas à utiliser vos méthodes.

Je fais fonctionner mon projet en faisant ouvrir puis fermer les fichiers par VBA mais je pense que c'est pas optimal.

Semaine pro je continue mes recherches.

Bon weekend à tous.

mikarien :

Bonjour,

Si tu nous en disais un peu plus sur ce que tu cherches à réaliser :

SQL et Power Query ne sont heureusement pas les seules solutions pour importer des données. On peut aussi y arriver très simplement avec VBA et les Array.

Apparemment tu souhaites importer une plage assez vaste. Cette plage couvre-t-elle la totalité des données de cette source ou est-ce seulement un petite partie de la feuille1 ?

Cette plage est-elle un tableau ou une table Excel en un seul bloc ? Sans espace (lignes ou colonnes) vide ?

Ces données doivent elles remplacer ("écraser") les données présentent dans la feuille destination ?

Dans ce cas un import simple du type Array suffirait sans doute !

A+