import .CSV vba excel

Version imprimable

Bonjour,

J’utilise le code ci-dessous afin d'importer des données .xlsx.
Je cherche à adapter la partie OLEDB à un import .csv . Pouvez vous m'aider?svp

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
Sub test()
 
Dim a As String
a = "Feuil2$"
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;*.csv")
    If Fichier = False Then Exit Sub
 
    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=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
 
     texte_SQL = "SELECT * FROM [" & a & Cellule & "] "
 
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
   Feuil3.Range("A2").CopyFromRecordset Rst
 
    Set Feuille = Nothing
    Set oCat = Nothing
    Cn.Close
    Set Cn = Nothing
 
 
 MsgBox "Données importées"
 
 
End Sub

24/04/2017, 06h29
kiki29

Salut, voir peut-être ici ?

Bonjour,

Et avec une requête sur le .csv (pas testé sur un .xlsx) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub CSV()
 
    Dim Fichier As String
 
    Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx;*.csv")
 
    If Fichier = False Then Exit Sub
 
    'exécute une requête er récup en feuille "Feuil3" à partir de "A2"
    With Worksheets("Feuil1").QueryTables.Add("TEXT;" & Fichier, Worksheets("Feuil3").Range("A2"))
 
        .TextFileSemicolonDelimiter = True 'le délimiteur est le point-virgule (;), à adapter !
        .Refresh 'met à jour
        .Delete 'supprime la requête
 
    End With
 
End Sub

24/04/2017, 07h22
Invité

Bonjour,
https://www.developpez.net/forums/d1...u/#post9163787