Requete SQL VBA avec jointure classeur externe et interne

**telecom_16** · 23/03/2017, 00h00

Bonjour,
Je me permets de vous écrire afin de demander de l'aide. J'utilise une requete SQL dans mon code vba pour récupérer des infos d'un classeur excel externe cependant je voulais savoir s'il est possible de faire une jointure entre mon classeur et le classeur externe?
Ex :
Tableau 1 (mon classeur) qui contient 2 colonnes A et B
Tableau 2 (classeur externe) qui contient 3 colonnes C D et F

le but est de faire une jointure entre les 2 tableau avec condition A=C et récupérer les colonnes du fichier externe C D et F

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
 
Tableau_Ext = "GLOBAL_NORD$"
Cellule = "A10:BK5000"
 
Dim Cn As ADODB.Connection
Dim oCat As ADOX.Catalog
Dim Fichier As Variant
Dim Feuille As ADOX.Table
 
Dim Rst As ADODB.Recordset
Dim texte_SQL As String
Dim Ar() As String, i As Long
 
    Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
    If Fichier = False Then Exit Sub
 
    Set Cn = New ADODB.Connection
    Set oCat = New ADOX.Catalog
 
    'Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Extended Properties=Excel 8.0;"
   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
 
     texte_SQL = "SELECT * FROM [" & Tableau_Ext & Cellule & "]"
 
   Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
   Feuil3.Range("A2").CopyFromRecordset Rst

Invité · 23/03/2017, 08h51

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
    With CreateObject("ADODB.Connection")
        .Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""Excel 12.0;HDR=YES"""
         Feuil3.Range("A2").CopyFromRecordset .Execute("SELECT * FROM [Feuil1$] As FrmInt inner join (select * from [Feuil1$] in 'c:\MyRep\Fichier.xlsx' 'Excel 12.0;HDR=YES;') As  FrmExt on  FrmExt.Id= FrmInt.Id")   '---- Lecture des fichiers ---
         .Close
    End With
End sub

**telecom_16** · 23/03/2017, 23h24

Merci beaucoup dysorthographie pour votre retour, le code fonctionne bien. Je voulais savoir est ce que on peut utiliser where à la place de inner join ?

**telecom_16** · 24/03/2017, 00h01

Désolé Pouvez vous s'il vous plait m'aider à adapter le code avec le .Open :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
'Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Extended Properties=Excel 8.0;"
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

Invité · 24/03/2017, 07h04

Envoyé par telecom_16

Désolé Pouvez vous s'il vous plait m'aider à adapter le code avec le .Open :
'Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Extended Properties=Excel 8.0;"
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

C'est exactement ce que j'ai fait au poste #2

**telecom_16** · 24/03/2017, 09h18

Bonjour,
Merci beaucoup pour votre retour, en fait, je me suis mal exprimé pour le .OPEN. Ma demande était de remplacer le 'c:\MyRep\Fichier.xlsx' 'Excel 12.0;HDR=YES;' par un fichier que j'importe via OpenFile car mon fichier externe change de nom.
Est ce que c'est possible d’introduire les 2 ligne ci-dessous dans la requête sql en question?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
    If Fichier = False Then Exit Sub

Cdt,

Invité · 24/03/2017, 07h00

Envoyé par telecom_16

Merci beaucoup dysorthographie pour votre retour, le code fonctionne bien. Je voulais savoir est ce que on peut utiliser where à la place de inner join ?

Bonjour,
Inner join et where c'est la même chose voir mieux!

Le langage Sql c'est puissant et le bonnes pratique je ne prescris que ça!

Mais si tu ne veux pas changer tes mauvaises habitudes, fais comme dab!

Je viens pour proposer des solutions dans les règles.

Mélanger l'inner join et le where complique considérablement le filtre si pour le coup tu veux utiliser le where!

Where inner and toto='tt' or inner and toto='gg' ! Il te faudra multiplier des conditions inutile!

Invité · 24/03/2017, 09h25

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Dim Fichier
Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
If Fichier = False Then Exit Sub
Importer CStr(Fichier), Feuil3.Range("A2")
End Sub
Sub Importer(Fichier As String, Destination As Range)
    With CreateObject("ADODB.Connection")
        .Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""Excel 12.0;HDR=YES"""
         Destination.CopyFromRecordset .Execute("SELECT * FROM [Feuil1$] As FrmInt inner join (select * from [Feuil1$] in '" & Fichier & "' 'Excel 12.0;HDR=YES;') As  FrmExt on  FrmExt.Id= FrmInt.Id")   '---- Lecture des fichiers ---
         .Close
    End With
End Sub

**telecom_16** · 24/03/2017, 15h06

Merci beaucoup pour votre aide ça marche bien.

**telecom_16** · 27/03/2017, 00h52

Bonjour dysorthographie,

Je suis bloqué sur le nom de la Feuil du fichier importé par la requête SQL, je m'explique le nom de le feuille change donc je dois l’écrire à son nom de source (Feuil1)
Nom de la feuille change beaucoup mais reste toujours dans la feuille 1 ex Feuil1(tableau123466) Feuil1(tableau123466)

Pourriez vous svp m'aider ? Merci beaucoup

Cdt,

Invité · 27/03/2017, 17h52

bonsoir,
si tu énumères les tables de ton classeur, tu es capable de reconnaître le bon sachant que tu auras toujours le nom qui s'affiche sur l'onglet et jamais feulle1.xxx!

**telecom_16** · 30/03/2017, 21h49

Bonsoir

j'ai trouvé ce code est que on peut l'adapter à notre besoin? svp

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim Ar() As String, i As Long
 
    For Each Feuille In oCat.Tables
        i = i + 1
        ReDim Preserve Ar(i)
        Ar(i) = Feuille.Name
    Next Feuille

Invité · 30/03/2017, 23h22

Bonsoir,
Je sais faire ce genre de code pour cela pas de problème.
https://www.developpez.net/forums/d1...s/#post9138433

Ma question est que dans ton poste tu parle de Feuil1(tableau123466) .

Je te demande comment tu peux reconnaître le nom de l'onglet sachant que c'est bien le nom coté excel et pas vba que tu verras.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim Cn As ObjectSub test()
Dim Fichier
Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
If Fichier = False Then Exit Sub
Importer CStr(Fichier), Sheets("Feuil3").Range("A2")
End Sub
Sub Importer(Fichier As String, Destination As Range)
Set Cn = CreateObject("ADODB.Connection")
    With Cn
        .Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & Fichier & ";extended properties=""Excel 12.0;HDR=YES"""
        If TableExiste("Feuil1$") Then Destination.CopyFromRecordset .Execute("SELECT * FROM [Feuil1$] As FrmExt inner join (select * from [Feuil1$] in '" & ThisWorkbook.FullName & "' 'Excel 12.0;HDR=YES;') As  FrmInt on  FrmInt.a= FrmExt.a")         '---- Lecture des fichiers ---
         .Close
    End With
End Sub
 
 
Public Property Get TableExiste(TableName As String) As Boolean
With Cn.OpenSchema(20)
    If Not .EOF Then
      .Filter = "TABLE_NAME ='" & Array(TableName, "''" & TableName & "''")(Abs(CBool(InStr(TableName, " ")))) & "'"
       TableExiste = Not .EOF
    End If
    .Close
End With
End Property

**telecom_16** · 03/04/2017, 00h57

Bonsoir,
Désolé pour la réponse tardive , en fait le fichier d'import à toujours un seul onglet donc c'est toujours feuil1 coté vba
Sinon le code fonctionne mais me donne rien

Cdt,

Invité · 03/04/2017, 07h07

Bonjour,
Avec ado tu ne pourras pas voir le nom feuil1 coté vba mais tableau123466 coté Excel.

Je réitère ma question, as tu le moyen de reconnaître le nom de l'onglet a récupérer. Ou tu récupère systématiquement le seule onglet présent?

**telecom_16** · 03/04/2017, 12h28

Bonjour,
Oui je récupère systématiquement le seule onglet présent. Pour le nom de l'onglet il change souvent donc il faut le connaitre à chaque maj afin changer le code

Invité · 03/04/2017, 13h24

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim Cn As Object
Sub test()
Dim Fichier
Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
If Fichier = False Then Exit Sub
Importer CStr(Fichier), Sheets("Feuil3").Range("A2")
End Sub
Sub Importer(Fichier As String, Destination As Range)
Dim Table As String
Set Cn = CreateObject("ADODB.Connection")
    With Cn
        .Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & Fichier & ";extended properties=""Excel 12.0;HDR=YES"""
        Table = PremiereTableAdo
        If Table <> "" Then Destination.CopyFromRecordset .Execute("SELECT * FROM [" & Table  & "] As FrmExt inner join (select * from [Feuil1$] in '" & ThisWorkbook.FullName & "' 'Excel 12.0;HDR=YES;') As  FrmInt on  FrmInt.a= FrmExt.a")       '---- Lecture des fichiers ---
         .Close
    End With
End Sub
 
 
Public Property Get PremiereTableAdo() As String
With Cn.OpenSchema(20)
    If Not .EOF Then
        PremiereTableAdo = .fields("TABLE_NAME")
    End If
    .Close
End With
End Property

**telecom_16** · 03/04/2017, 22h58

Bonsoir

Parfait, c'est bon merci beaucoup pour ton aide.
Une dernière demande stp j'ai parfois des fichiers .csv à importer, j'essaye de l'adapter avec la connexion ci dessous mais ce ne marche pas pourrais tu m'aider stp

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.Open "Provider = Microsoft.Jet.OLEDB.4.0;data source=" & Fichier & "Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
        Table = PremiereTableAdo

Invité · 04/04/2017, 09h24

Bonjour,

je n'arrive toujours pas à prendre en compte le séparateur de colonnes {Delimited( ; }!

je fais les chose comme il faut mais rien y fait! on me dit qu'il faut bricoler la base de registre ce qui veut dire que l'application n'est pas transportable (qui fait ça)!
quand je demande de l'aide on me répond si tu ne le sais pas qui le saurera!

enfin voila ça marche sur certaines bécane! les paramétré régionaux semble-t-il???

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim Cn As ObjectSub test()
Dim Fichier
'Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
'If Fichier = False Then Exit Sub
Importer "C:\MyRepertoire\Nouveau dossier", Sheets("Feuil3").Range("A2")
End Sub
Sub Importer(Repertoire As String, Destination As Range)
Dim Table As String
Set Cn = CreateObject("ADODB.Connection")
    With Cn
        .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Repertoire & ";Extended Properties='text;HDR=Yes;FMT=Delimited(;);'"
        Table = PremiereTableAdo
        If Table <> "" Then Destination.CopyFromRecordset .Execute("SELECT * FROM [" & Replace(Table, ".CSV", "") & "] As FrmExt ")      '---- Lecture des fichiers ---
         .Close
    End With
End Sub
 
Public Property Get PremiereTableAdo() As String
With Cn.OpenSchema(20)
    If Not .EOF Then
        PremiereTableAdo = .fields("TABLE_NAME")
    End If
    .Close
End With
End Property

Édite:

j'ai trouvé!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Dim Cn As Object, txt As String
Sub test()
Dim Fichier
txt = "[F.CSV]" & vbCrLf & _
"Format=Delimited(;)"
'
'Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
'If Fichier = False Then Exit Sub
Importer "C:\MyRepertoire\Nouveau dossier", Sheets("Feuil3").Range("A2")
End Sub
Sub Importer(Repertoire As String, Destination As Range)
Dim Table As String
Set Cn = CreateObject("ADODB.Connection")
    With Cn
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Repertoire & ";Extended Properties=""Text;HDR=YES;FMT=Delimited;"";"
        Table = PremiereTableAdo
        If Table <> "" Then
            NewFichierTxt Repertoire & "\schema.ini", Replace(txt, "F.CSV", Replace(Table, "#", "."))
           Destination.CopyFromRecordset .Execute("SELECT * FROM [" & Table & "] As FrmExt inner join (select * from [Feuil1$] in '" & ThisWorkbook.FullName & "' 'Excel 12.0;HDR=YES;') As  FrmInt on  FrmInt.a= FrmExt.a")        '---- Lecture des fichiers ---
            Kill Repertoire & "\schema.ini"
            End If
         .Close
    End With
End Sub
 
Public Property Get PremiereTableAdo() As String
With Cn.OpenSchema(20)
    If Not .EOF Then
        PremiereTableAdo = .fields("TABLE_NAME")
    End If
    .Close
End With
End Property
Private Sub NewFichierTxt(Fichier, txt)
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Sub