Discussion :

[produ13]

Bonjour le forum,

Vous n'imaginez pas le temps que j'ai passé à chercher sur le net avant de poster ce billet...

En vba, je souhaiterais créer une table access remplie avec des données récupérées depuis la sources suivante (le lien revoie vers un Csv qui contient des données d'une action boursière avec Date/volume/cours/...)
https://query1.finance.yahoo.com/v7/...stedClose=true

Pour la récupération des données, J'ai opté pour une requête HTTP. Tout est stocké dans la variable sLecture.
Ce que je n'arrive pas à faire, c'est créer la table et remplir la table avec les données. Pourriez-vous svp m'aider????

Voici mon code.

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 jedeviensfou()
Dim oXMLHTTP As MSXML2.XMLHTTP
Dim sHTTP As String
Dim sLecture As String 'reçoit le texte du csv
Dim Db As Dao.Database
Dim Tbl As Dao.TableDef
 
sHTTP = "https://query1.finance.yahoo.com/v7/finance/download/FP.PA?period1=1579289693&period2=1610912093&interval=1d&events=history&includeAdjustedClose=  true " 'chaîne de requête du csv
 
Set oXMLHTTP = New MSXML2.XMLHTTP
 
oXMLHTTP.Open "GET", sHTTP, True
oXMLHTTP.send
DoEvents
sLecture = oXMLHTTP.responseText 'c'est dans la boîte!
 
 
Set Db = CurrentDb
Set Tbl = Db.CreateTableDef("action")
 
Set oFld = Tbl.CreateField("AdresseClient", dbText, 120)
'Etape 2 : Définit les propriétés
oFld.AllowZeroLength = False 'Chaine vide autorisée : Non
oFld.Required = True         'Null interdit : Oui
 
Tbl.Fields.Append oFld
 Tbl.Fields.Refresh
Db.TableDefs.Append Tbl
 
'DoCmd.TransferText acImportDelim, , "heh", , True
'Application.ImportXML sLecture, acStructureAndData
Set oXMLHTTP = Nothing
 
End Sub

[Zekraoui_Jakani]

Access gère très bien les imports en CSV, autant l'essayer et laisser Access écrire directement dans la table "Action".
La 1ère fois, faites le précautionneusement en faisant bien attention aux spécifications d'import, surtout les formats dates et les séparateurs décimaux pour éviter les surprises.

[produ13]

Bonjour,

Merci pour votre retour.
La solution de laisser gérer l'import des CSV me parait bonne.
Pourriez-vous svp m'indiquer comment importer automatiquement le fichier depuis internet en vba ?

[Zekraoui_Jakani]

Voici un exemple qui importe les extraits bancaires à partir du site de la banque:
Commencez par télécharger votre fichier vers le dossier "Téléchargement"; en principe, il est toujours en format CSV.

Code :

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

1
2
3
4
Private Sub CommandImporterTransactions_Click()
    'CommandImporterTransactions est un bouton de commande sur le formulaire
    Call import_CSVfile(Replace(Me.IBAN, " ", ""), Me.RecordSource, Me.Name)   'dans votre cas, ce sera "Call import_CSVfile(NomDuFichier à importer)" 
End Sub

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
 
Public Function import_CSVfile(Compte, Tbl, frm)  ' paramètres à adapter
On Error GoTo error_mgr
 
    Dim title As String
    Dim position As Long
    Dim fileToImport, TblExtraits As String
    Dim chemin, myMsg, sMsg As String
    Dim txtFileName, SourcePath, DestinationPath As String
    Dim nbrOperations As Long
    Dim xMontant As Variant
 
    SourcePath = "C:\Users\jakan\Downloads\"  ' à adapter
    DestinationPath = "C:\Users\jakan\Documents\Budget\Extraits\Extraits" & Year(Now()) & "\"  ' à adapter
    TblExtraits = DLookup("[Tbl_Extraits]", "[$_ListeDesComptes]", "[Sélection]=True")  ' à adapter
 
    Compte = Compte & "-" & Format(Now, "yyyymmdd") & ".csv"   ' = structure du nom de fichier à importer
    txtFileName = Dir(SourcePath & Compte)
 
    If Len(txtFileName) > 0 Then
      Else
        myMsg = "Aucun extrait n'existe pour le compte " & Left(Compte, 16) & vbLf
        myMsg = myMsg & "sous le répertoire : '" & SourcePath & "'" & vbLf & vbLf
        myMsg = myMsg & "Veuillez importer les données du site de votre banque ou" & vbLf
        myMsg = myMsg & "Vérifiez que le fichier se trouve bien sous le répertoire 'Téléchargement'."
        MsgBox myMsg, vbInformation + vbOKOnly, "Fichier des Données Bancaires"
        Exit Function
    End If
 
    txtFileName = SourcePath & Dir(SourcePath & Compte)
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE [" & TblExtraits & "].* FROM [" & TblExtraits & "];"
    DoCmd.TransferText transferType:=acImportDelim, _
    SpecificationName:="ExtraitsBancairesImportSpecification", _
    TableName:=TblExtraits, FileName:=txtFileName, hasfieldnames:=True
 
   '"ExtraitsBancairesImportSpecification": c'est ici que les formats date et séparateur décimal sont définis.
   'd'autres instructions peuvent être ajoutées ici .....
   End Sub

[produ13]

Bonjour,

Merci pour votre réponse. Je m'en suis inspiré pour corriger mon code qui ressemble à ceci maintenant.

Code :

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

1
2
3
4
5
6
7
 
 
 
Private Sub test()
    'CommandImporterTransactions est un bouton de commande sur le formulaire
    Call import_CSVfile
End Sub

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
44
45
46
47
48
49
 
Public Function import_CSVfile()  ' paramètres à adapter
    On Error Resume Next
    Dim oDb As DAO.Database
    Dim SelectionGene As DAO.Recordset
    Dim title As String
    Dim position As Long
    Dim fileToImport, TblExtraits As String
    Dim chemin, myMsg, sMsg As String
    Dim txtFileName, SourcePath, DestinationPath As String
    Dim nbrOperations As Long
    Dim xMontant As Variant
    Dim myURL As String
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    Set oDb = CurrentDb
    SourcePath = "C:\Users\G51775\Downloads\"
    csv = "action.csv"
    With oDb
        Set SelectionGene = .OpenRecordset(.QueryDefs("Requête1").SQL)
 
    End With
    DoCmd.SetWarnings False
    While Not SelectionGene.EOF
        ticker = SelectionGene.Fields(0).Value
        Action = SelectionGene.Fields(1).Value
        txtFileName = Dir(SourcePath & csv)
        myURL = "https://query1.finance.yahoo.com/v7/finance/download/" & ticker & "?period1=1579822990&period2=1611445390&interval=1d&events=history&includeAdjustedClose=true"
        WinHttpReq.Open "GET", myURL, True
        WinHttpReq.send
        Sleep 5000
        DoEvents
        myURL = WinHttpReq.responseText
        If WinHttpReq.status = 200 Then
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1
            oStream.Write WinHttpReq.responseBody
            oStream.SaveToFile txtFileName, 2
            oStream.Close
        End If
        DoCmd.DeleteObject acTable, Action
        DoCmd.TransferText transferType:=acImportDelim, _
        SpecificationName:="ImportSpecificationAction", _
        TableName:=Action, FileName:=txtFileName, hasfieldnames:=True
    SelectionGene.MoveNext
     Wend
 
     DoCmd.SetWarnings