Discussion :

[GregCompta]

Bonjour à tous,

Le soucis qui me tracasse n'est pas très commun, et j'espère ne pas faire doublon avec un autre post, car malgré mes longues, exhaustives et infructueuses recherches, je n'ai trouvé aucune réponse !!! Je vous soumet donc mon problème, code et fichier excel de manière à mieux appréhender ma requête.

Ce qui se passe ! => Le code fonctionne parfaitement bien sur mon PC (qui lui est sous Excel 2016) sauf que lorsque je l'exécute à mon boulot, ça plante et me met le message d'erreur ci-dessous.
Je pense que c'est juste un problème de version, mais je ne suis pas expert... Si c'est cela, qui peut me dire comment adapter mon code svp ?

Le fichier : il recherche une page sur internet (cours de conversion), l'enregistre dans un fichier tampon, par la suite supprimé, et extrait chaque cours en fonction de sa devise.
Si c'est possible, j'aurais bien aimé aussi que quelqu'un me dise comment optimiser le code car il rame un petit peu..

Merci mille fois à vous de votre aide..



Voici le message d'erreur




Code pour la récupération de la page web

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
 
Option Explicit
    Dim dc As Long
    Dim page_web As String
    Dim chemin As String
    Dim donnees_fichier() As Byte
    Dim objet_reponse As Object
 
Sub recuperer_web()
 
dc = ThisWorkbook.Worksheets("Cours").Cells(2, Columns.Count).End(xlToLeft).Column
If ThisWorkbook.Worksheets("Cours").Cells(2, dc).Value = Date Then
    MsgBox "Il existe déjà les devises d'aujourd'hui", vbInformation + vbOKOnly, "MISE A JOUR"
    Exit Sub
End If
 
Set objet_reponse = Nothing
Set objet_reponse = CreateObject("WinHTTP.WinHTTPrequest.5.1")
 
page_web = "http://www.boursorama.com/bourse/devises/parite.phtml"
chemin = ThisWorkbook.Path & "\donnees.txt"
 
With objet_reponse
    .Open "GET", page_web, False
    .Send
    donnees_fichier = .ResponseBody
End With
Set objet_reponse = Nothing
 
Open chemin For Binary Access Write As #9
    Put #9, 1, donnees_fichier
Close #9
 
Call recuperer_taux(chemin)
Kill chemin
 
End Sub

Code pour l'extraction des devises

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
 
Sub recuperer_taux(chemin As String)
Dim contenu As String, contenu_intermediaire As String: Dim taille_fichier As Long
Dim position_fin As Long: Dim position_depart As Long
Dim i As Long, dc As Long, dl As Long, Devise As String
 
contenu = ""
Open chemin For Input As #1
If LOF(1) = 0 Then Exit Sub
    Do While EOF(1) <> True
        Line Input #1, contenu_intermediaire 'taille_fichier = LOF(1)
        contenu = contenu & contenu_intermediaire 'input(taille_fichier, 1)
    Loop
Close #1
 
dc = ThisWorkbook.Worksheets("Cours").Cells(2, Columns.Count).End(xlToLeft).Column + 1
ThisWorkbook.Worksheets("Cours").Cells(2, dc).Value = Now
dl = ThisWorkbook.Worksheets("Cours").Range("A" & Rows.Count).End(xlUp).Row
 
For i = 3 To dl Step 1
 
    position_depart = InStrRev(contenu, Worksheets("PaysDevise").Cells(i - 1, 3) & "</td>")
    If position_depart = 0 Then
        Devise = Mid(contenu, 1, Len(contenu))
    Else
        Devise = Mid(contenu, position_depart, Len(contenu))
    End If
        position_fin = InStr(1, Devise, "</span>")
        Devise = Left(Devise, position_fin)
    position_depart = InStrRev(Devise, ">") + 1
    Devise = Mid(Devise, position_depart, position_fin - position_depart)
 
    Devise = Replace(Devise, " ", "")
 
ThisWorkbook.Worksheets("Cours").Cells(i, dc).Value = Devise
Next i
 
End Sub

Fichier :
Cours de Conversion.xlsm