Lien Excel et base de données SQL sous vba

Version imprimable

Bonjour à tous,

J'ai créé une macro qui me permet d'exécuter une requête SQL et d'importer les données sur Excel.
Tout fonctionne bien sauf que lors de l'importation, les entetes ne sont pas importées.
Connaissez vous la commande qui permet ça ?

Je vous remercie par avance.

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
Sub Requête()
 
Dim Login As String
Dim pass As String
 
Sheets("Extract").UsedRange.ClearContents
Sheets("CPN1").Activate
 
Login = Sheets("CPN1").Range("B1").Value
pass = Sheets("CPN1").Range("B2").Value
 
 
Dim x As ADODB.Connection
Set x = New ADODB.Connection
 
Dim r As ADODB.Recordset
Set r = New ADODB.Recordset
 
Dim Sql As String
 
x.Open ("DRIVER={Sybase IQ}; CommLinks=TCPIP{host=" + "sybhost_iqdwfmtb" + ";port=" + "9000" + "}; DBN=; UID=" + _
        Login + "; PWD=" + pass + "; ENG=IX_DW_MO")
 
Sql = "SELECT A.*, B.Nomenclature FROM vu_D1_Structure A, dim_TradeAsset B WHERE A.StructureId = B.StructureId"
 
r.Open Sql, x
 
Sheets("Extract").Range("A2").CopyFromRecordset r
 
r.Close
x.Close
 
Set r = Nothing
Set x = Nothing
 
End Sub

Cordialement,
Freudsw

Bonjour,

Peut être que ceci pourrait aider :

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
Sub Requête()
 
Dim Login As String
Dim pass As String
Dim Col_index As Integer
 
 
Sheets("Extract").UsedRange.ClearContents
Sheets("CPN1").Activate
 
Login = Sheets("CPN1").Range("B1").Value
pass = Sheets("CPN1").Range("B2").Value
 
 
Dim x As ADODB.Connection
Set x = New ADODB.Connection
 
Dim r As ADODB.Recordset
Set r = New ADODB.Recordset
 
Dim Sql As String
 
x.Open ("DRIVER={Sybase IQ}; CommLinks=TCPIP{host=" + "sybhost_iqdwfmtb" + ";port=" + "9000" + "}; DBN=; UID=" + _
        Login + "; PWD=" + pass + "; ENG=IX_DW_MO")
 
Sql = "SELECT A.*, B.Nomenclature FROM vu_D1_Structure A, dim_TradeAsset B WHERE A.StructureId = B.StructureId"
 
r.Open Sql, x
 
Sheets("Extract").Range("A2").CopyFromRecordset r
 
For Col_index = 0 To r.Fields.Count - 1
    Range("A1").Offset(0, Col_index).Value =r.Fields(Col_index).Name
Next
 
r.Close
x.Close
 
Set r = Nothing
Set x = Nothing
 
End Sub

Bien cordialement,

Poulpe

20/10/2015, 10h58
Freudsw

Parfait! Merci Mr Poulpe

Re-Bonjour,

Merci pour ta réponse rapide, cela fonctionne parfaitement.
Il faut juste specifier au code dans quelle feuille coler les entêtes.

Merci encore
Cordialement,
Freudsw