Discussion :

[lito74]

Bonjour
Je souhaite, quotidiennement et automatiquement, mettre à jour une table contenant le taux de change de certaines devises ?
Je sais que c'est vague comme question, mais avez-vous une idée ?
Merci

[LedZeppII]

Bonjour,

Je vais te dire comment je fais.

J'ai une table XRates ayant pour champs
Devise : texte (3)
EUR2DEV : Numérique>Décimal (précision 18, Echelle 4)

A la main j'ai entré les devises qui m'intéressent (par ex: CHF, GBP, JPY, NOK, SEK, USD)
Ensuite je lance cette fonction (appelée par un bouton)

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Function ImportXmlEurofXref()
' utilise ref VBA : Microsoft XML, version 2 ...\system32\msxml.dll
Dim xmlDoc As MSXML.DOMDocument, xmlCube As MSXML.IXMLDOMNode, xmlNode As MSXML.IXMLDOMNode
Dim db As DAO.Database, rXrates As DAO.Recordset
Dim strCur As String, strRate As String, curRate As Currency
Dim strDecCar As String, strThCar As String, strTstFmt As String
 
strTstFmt = Format(1234.5678, "#,##0.0000")
If Len(strTstFmt) = 10 Then
   strThCar = Mid(strTstFmt, 2, 1)
Else
   strThCar = ""
End If
strDecCar = Mid(strTstFmt, Len(strTstFmt) - 4, 1)
 
Set xmlDoc = New MSXML.DOMDocument
' Charge fichier xml
xmlDoc.Load "http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml"
 
' Attendre que le document soit interprété
While (xmlDoc.parsed = False)
    DoEvents
Wend
 
' Format fichier xml :
' ---------------------------------------------------
'   <Cube>
'       <Cube time="2009-03-05">
'           <Cube currency="USD" rate="1.2555"/>
'           ....
'           <Cube currency="ZAR" rate="13.2079"/>
'       </Cube>
'   </Cube>
 
' Obtenir premier élément "Cube" dans le document
Set xmlCube = xmlDoc.documentElement.SelectSingleNode("Cube")
 
' Elément "Cube" de niveau inférieur
Set xmlCube = xmlCube.SelectSingleNode("Cube")
 
Set db = CurrentDb
Set rXrates = db.OpenRecordset("Xrates", dbOpenDynaset)
 
' Boucler sur les noeuds inférieurs (<Cube currency="CCC" rate="n.nnnn"/>)
'  et récupérer les attributs "currency" et "rate".
'  Le taux est EUR/DEVISE (1 EUR = n.nnnn CCC)
For Each xmlNode In xmlCube.ChildNodes
    strCur = xmlNode.Attributes.getNamedItem("currency").NodeValue
    strRate = xmlNode.Attributes.getNamedItem("rate").NodeValue
    strRate = Replace(strRate, ".", strDecCar)
    curRate = CCur(strRate)
 
    'Debug.Print "1 EUR = " & curRate & " " & strCur, strRate
 
    ' Rechercher la devise dans la table et la mettre à jour
    rXrates.FindFirst "Devise=""" & strCur & """"
    If Not rXrates.NoMatch And curRate <> 0 Then
       rXrates.Edit
       rXrates("EUR2DEV") = curRate
       rXrates.Update
    End If
 
Next
 
ENDP:
rXrates.Close
db.Close
 
Set xmlCube = Nothing
Set xmlDoc = Nothing
 
End Function

La fonction récupère un fichier xml sur internet (http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml) et met à jour
le taux de change dans la table XRates.
Dans le projet VBA il faut une référence à DAO et une à "Microsoft XML, version 2".

Si les devises dont tu as besoin sont dans le fichier xml tu doit pouvoir utiliser mon code.
Devises disponibles

A+