Création d'une liaison ADODB

Version imprimable

Bonjour,

J'essaie de créer une macro qui me va copier coller des données d'un autre fichier excel dans l'ouvrir. J'ai lu sur différents posts qu'il faut commencer par créer une connexion ADO. J'ai donc essayé mais j'obtiens un message d'erreur.... Voici le début de ma macro :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub ouverture() Dim Cn As ADODB.Connection Dim Fichier As String 'Définit le classeur fermé servant de base de données Fichier = "G:\blablabla" Set Cn = New ADODB.Connection With Cn .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _ & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;""" .Open End With End Sub
Le problème réside dans le lancement de la macro, j'obtiens le message suivant : Compile error: User-defined type not defined

Savez-vous pourquoi?

Je précise que je travaille sous Excel 2010....

Merci à toutes et à tous,

Très bonne journée à vous et surtout bon week-end!

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub ouverture()
 
Dim Cn As Object'ADODB.Connection
Dim Fichier As String
 
'Définit le classeur fermé servant de base de données
Fichier = "G:\blablabla\fichier.xls"
 
Set Cn = creatobject("ADODB.Connection")
 
With Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
End With
 
 
End Sub

20/03/2015, 15h07
Nico Chg

Le code de rdurupt est bien et va répondre à ta problématique, mais juste pour savoir d'ou vient ton erreur :

Tu définis Cn as ADODB.Connection, hors tu n'a pas activer les bonnes références, et VBA ne reconnais pas ce type de variables. Il devine alors que c'est un type de variable définis par l'utilisateur, d'ou ton erreur.

La ou rdurupt ne génère pas l'erreur, c'est qu'il instancie Cn d'abord comme un objet (type reconnu par VBA), et qu'uniquement après il le type en ADODB.Connection, via le CreateObject. ça s'appelle du Late Bindings, contrairement à ce que tu as fait, qui est de l'early bindings.
20/03/2015, 18h00
kiki29

Salut, autrement dit voir : Early ou Late Binding, et développer en Early et déployer en Late, surtout si environnement hétérogène.
23/03/2015, 09h57
Mistigri5

Bonjour,

Je viens d'essayer le code mais j'aiun lessage d'erreur lorsque j'éxécute le code.

Je code se bloque sur 'createobject' et j'ai un message d'erreur suivant : 'Compile error : Sub or function not defined'

Auriez-vous une petite idée pour résoure ce problème ?

Je vous remercie!

Boris

Bonjour,
:oops: faute de frappe :oops:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub ouverture()
 
Dim Cn As Object'ADODB.Connection
Dim Fichier As String
 
'Définit le classeur fermé servant de base de données
Fichier = "G:\blablabla\fichier.xls"
 
Set Cn = CreateObject("ADODB.Connection")
 
With Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
End With
 
 
End Sub

23/03/2015, 10h27
Nico Chg

Bonjour

Est il besoin de préciser "Application" devant CreateObject, ou c'est implicite ?
23/03/2015, 10h34
Invité

Non pas besoin en revanche il est possible que son fichier vienne d'un autre pc et que visual basic for application soit considéré comme manquante des les référence. dans ce cas aller das les références et décocher les librairies manquante!
Menu->Outils->Références de VBA!

Merci à tous pour vos réponses! Effectivement la connexion marche bien.

Maintenant j'essaie de créer du nouveau code pour sélectionner une feuille du workbook auquel je me suis connecté pour prendre une feuille et la coller dans le classeur actif.

J'ai essayé de compléter le code pour copier coller, masi j'arrive à un message d'erreur....'Operation is not allowed when the object is closed'.

En fait j'ai utilisé la fonction recordset pour coller.

Est-ce que vous auriez quelques bribes d'informations pour m'aider à résoudre ce problème peut etre ?

Je vous remercie!
Code:

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 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 Sub ouverture() 'Dimensionnement des variables Dim ADOCommand As Object Dim Cn As Object 'ADODB.Connection Dim Fichier As String Dim Feuille As String Dim Rst As Object 'ADODB.Recordset 'Définit le classeur fermé servant de base de données Fichier = "G:\Equipe\Convertibles\Recherche\Interne\Quantitative-screening\___Ranking Fundamental Mirabaud MCBE & MCBG__\MCBG\MCBG_GICS_Ranking\Japan\MCB_Japan_CV & Topix.xls" Feuille = "RankingGlobal" 'Création de la connexion Set Cn = CreateObject("ADODB.Connection") With Cn .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _ & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;""" .Open End With 'On copie les rankings Set ADOCommand = CreateObject("ADODB.Command") With ADOCommand .CommandText = "SELECT * FROM [" & Feuille & "]" End With 'Ajout de la feuille Workbooks("Japan_historical_Ranking.xlsm").Activate Sheets.Add ActiveSheet.Name = Format$(Date, "yyyymmdd") ActiveSheet.Tab.ColorIndex = 2 'Collage Set Rst = CreateObject("ADODB.Recordset") Range("A1").CopyFromRecordset Rst Rst.Close End Sub

23/03/2015, 14h15
Nico Chg

Re-bonjour,

Peut être que je me trompe, mais si tu veux copier des objets Excel (une feuille par exemple), ce n'est pas possible via une connexion ADO. Tu peux récupérer les données présentes dans la feuille, mais pour copier une feuille, il faut que le classeur soit ouvert (que tu ai créé une instance du classeur, dans laquelle sera disponible tes objets).
23/03/2015, 14h27
Mistigri5

Bonjour Nico,

Je sais que sur Excel 2003 c'était possible de sélectionner les données d'une feuille appartenant à un classeur fermé, puis de le coller dans le classeur ouvert...Je sais parce que je l'ai fait :mouarf:

Est-ce qeu tu penses qu'Excel 2010 annule cette fonctionnalité ?

Merci à toi!
23/03/2015, 14h34
Nico Chg

Je dois certainement me tromper dans ce cas ! J'utilise peu les liaisons ADO, mea culpa !

pb equivalent

Salut,

Je me suis inspiré de quelques codes trouvés sur internet et de ce qu'il y avait ci-dessous, mais j'ai quand même une erreur de compilation.

Initialement:

Code:

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub testexportsql()
    Dim cn As ADODB.Connection
    Dim ServerName As String
    Dim DatabaseName As String
    Dim TableName As String
    Dim UserID As String
    Dim Password As String
    Dim rs As ADODB.Recordset
    Dim RowCounter As Long
    Dim NoOfFields As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim ColCounter As Integer
 
    Set rs = New ADODB.Recordset
 
    ServerName = "xxx\\SQL2016" ' Enter your server name here
    DatabaseName = "DATAWAREHOUSE" ' Enter your  database name here
    TableName = "AlbertaFire_import" ' Enter your Table name here
    UserID = "xx" ' Enter your user ID here
    ' (Leave ID and Password blank if using windows Authentification")
    Password = "xxx" ' Enter your password here
    NoOfFields = 331 ' Enter number of fields to update (eg. columns in your worksheet)
    StartRow = 2 ' Enter row in sheet to start reading  records
    EndRow = 200 ' Enter row of last record in sheet
 
     '  CHANGES
    Dim shtSheetToWork As Worksheet
    Set shtSheetToWork = ActiveWorkbook.Worksheets("customer_master")
     '********
 
    Set cn = New ADODB.Connection
    cn.Open "Driver={SQL Server};Server=" & ServerName & ";Database=" & DatabaseName & _
    ";Uid=" & UserID & ";Pwd=" & Password & ";"
 
    rs.Open TableName, cn, adOpenKeyset, adLockOptimistic
 
     'EndRow = shtSheetToWork.Cells(Rows.Count, 1).End(xlUp).Row
    For RowCounter = StartRow To EndRow
        rs.AddNew
        For ColCounter = 1 To NoOfFields
        'On Error Resume Next
            rs(ColCounter - 1) = shtSheetToWork.Cells(RowCounter, ColCounter)
        Next ColCounter
        Debug.Print RowCounter
    Next RowCounter
    rs.UpdateBatch
 
     ' Tidy up
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
 
End Sub

Apres vos conseils:

Code:

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub testexportsql()
    Dim Cn As Object 'ADODB.Connection
    Dim ServerName As String
    Dim DatabaseName As String
    Dim TableName As String
    Dim UserID As String
    Dim Password As String
    Dim rs As Object 'ADODB.Recordset
    Dim RowCounter As Long
    Dim NoOfFields As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim ColCounter As Integer
 
    Set rs = creatobject("ADODB.Recordset")
 
    ServerName = "xxx\\SQL2016" ' Enter your server name here
    DatabaseName = "DATAWAREHOUSE" ' Enter your  database name here
    TableName = "AlbertaFire_import" ' Enter your Table name here
    UserID = "xxx" ' Enter your user ID here
    ' (Leave ID and Password blank if using windows Authentification")
    Password = "xx" ' Enter your password here
    NoOfFields = 331 ' Enter number of fields to update (eg. columns in your worksheet)
    StartRow = 2 ' Enter row in sheet to start reading  records
    EndRow = 200 ' Enter row of last record in sheet
 
     '  CHANGES
    Dim shtSheetToWork As Worksheet
    Set shtSheetToWork = ActiveWorkbook.Worksheets("customer_master")
     '********
 
    Set Cn = creatobject("ADODB.Connection")
    Cn.Open "Driver={SQL Server};Server=" & ServerName & ";Database=" & DatabaseName & _
    ";Uid=" & UserID & ";Pwd=" & Password & ";"
 
    rs.Open TableName, Cn, adOpenKeyset, adLockOptimistic
 
     'EndRow = shtSheetToWork.Cells(Rows.Count, 1).End(xlUp).Row
    For RowCounter = StartRow To EndRow
        rs.AddNew
        For ColCounter = 1 To NoOfFields
        'On Error Resume Next
            rs(ColCounter - 1) = shtSheetToWork.Cells(RowCounter, ColCounter)
        Next ColCounter
        Debug.Print RowCounter
    Next RowCounter
    rs.UpdateBatch
 
     ' Tidy up
    rs.Close
    Set rs = Nothing
    Cn.Close
    Set Cn = Nothing
 
End Sub

Dans le premier cas "User defined type not defined"
Dans le second cas il ne connait pas la fonction creatobj

Merci!