Discussion :

[snoups58]

Bonjour à tous,

j'ai vue que cette API avait pas mal de sujet mais je n'ai pas trouvé de solution à l'heure actuelle.

Voici mon soucis:
Je dois télécharger des fichiers (url différentes paramétrées) puis je dois effectuer des traitements sur ceux-ci.

Mon problème se situe au niveau de la fonction de téléchargement qui me renvoie un code erreur -2147024891 décrite comme "erreur définie par l'application ou par l'objet"

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
 
Private Declare PtrSafe Function URLDownloadToFile _
    Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As LongPtr
 
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" _
    (ByVal lpszUrlName As String) As LongPtr
 
 
Function U1000_TelechargeFichier(ByVal LienFichierURL As String, _
    ByVal LienFichierLocal As String) As Boolean
 
    Dim ReponseAPI As LongPtr
 
    ReponseAPI = URLDownloadToFile(0&, "http://fauconnier.developpez.com/forums/images/densites.png", _
          "D:\densites.png", 0&, 0&)
    'ReponseAPI = URLDownloadToFile(0&, LienFichierURL, LienFichierLocal, 0&, 0&)
 
    MsgBox Error(ReponseAPI)
 
    If ReponseAPI <> 0 Or Dir(LienFichierLocal, vbDirectory) = vbNullString Then
      U1000_TelechargeFichier = False
    Else
      U1000_TelechargeFichier = True
    End If
 
End Function

Bien entendu j'ai essayé pas mal de chose et comme vous pouvez le voir même une simple image ne fonctionne pas, même code erreur.

Cela fonctionne de temps en temps, mais je sais pas quel est le déclencheur. Je ferme Excel, puis je réouvre 5 minutes après et ça fonctionne deux ou trois fois d'affiler, des fois pas du tout, bref je sais plus quoi tenter

Quelqu'un aurait une idée ?

[Marc-L]

Bonjour,

jamais eu de souci de mon côté avec différentes versions 32 bits d'Excel …

[snoups58]

Bonjour,

après plusieurs test divers et varié, j'ai trouvé quels sont mes soucis.
* FTP d'un prestataire externe qui n'accepte que les connexions par IE (filezilla, chrome impossible)
* Un proxy qui à priori n'aime pas trop non plus la commande.

Bref un beau merdier.


Du coup après plusieurs tentative j'arrive à une solution, pas encore acceptable mais qui pourra donner des piste de recherche (que je n'arrive pas à débloquer)

voici l'évolution du 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
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
 
Private Declare Function URLDownloadToFile _
    Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long
 
Sub U1000_TelechargeFichier(ByVal URLSource As String, ByVal FichierSource As String, _
    ByVal LienFichierLocal As String)
 
  Dim IE As InternetExplorer
  Dim PageInternet As HTMLDocument
  Dim Element As HTMLAnchorElement
  Dim ReponseAPI As Long
 
  Dim FichierTrouve As Boolean
 
  Set IE = New InternetExplorer
 
  IE.Navigate URLSource
  IE.Visible = False: IE.Top = 0: IE.Left = 0
 
  'on attend l'ouverture complète de la page web
  Do Until IE.readyState = READYSTATE_COMPLETE
      DoEvents
  Loop
 
  Set PageInternet = IE.Document
 
  FichierTrouve = False
  For Each Element In PageInternet.getElementsByTagName("a")
    If FichierSource = Element.innerText Then
      FichierTrouve = True
      Element.Click
 
      Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
      Loop
 
      ReponseAPI = URLDownloadToFile(0&, Element.href, LienFichierLocal, 0&, 0&)
      'ReponseAPI = URLDownloadToFile(0&, URLSource & FichierSource, LienFichierLocal, 0&, 0&)
 
      Exit For
    End If
  Next Element
 
  IE.Quit
  Set Element = Nothing
  Set PageInternet = Nothing
  Set IE = Nothing
 
 
  If Not FichierTrouve Then
    MsgBox ("Le fichier " & FichierSource & _
      " n'a pas été trouvé depuis l'adresse " & URLSource & Chr(13) & "Le traitement s'arrête ici !!")
    L9000_FinTraitement
  ElseIf ReponseAPI <> 0 Or Dir(LienFichierLocal) = "" Then
    MsgBox ("Le téléchargement du fichier " & FichierSource & _
      " a échoué depuis l'adresse " & URLSource & Chr(13) & "Le traitement s'arrête ici !!")
    L9000_FinTraitement
  End If
 
End Sub

Fonctionne à tous les coup si je met un point d'arrêt dans ce module (mis sur Element.Click puis sur URLDownloadToFile)
Ne fonctionne pas toujours dès que je n'ai plus de point d'arrêt mais toujours en visualisation du code
Ne fonctionne plus du tout lorsque la visualisation du code est fermé


Pourquoi ai-je fait cela, tout simplement parce que indiquer le lien direct du FTP avec mot de pass et user dans l'url + le nom du fichier renvoyais un refus d'accès, du coup j'ai simulé l'ouverture de IE avec un téléchargement en cache afin de pouvoir faire passer le téléchargement direct.


Ps: J'ai tenté la solution du téléchargement avec l'objet XMLHTTP, cela ne fonctionne pas du tout
j'ai également tenté la solution FTP, ne fonctionne pas du tout


Merci pour votre aide, parce que je suis un peu désespérer de devoir simuler IE jusqu'au bout en bypassant les boite de dialogue ce qui rend le code vraiment moche ^^

[Marc-L]

Avec ce genre de contraintes, le téléchargement ne peut être lancé qu'à partir d'IE ou en le pilotant.

Voir le chapitre 9 dans le tutoriel VBA et développement Web …

[snoups58]

Arf pas d'autre solution qu'en pilotant IE

Bon bah du coup j'ai un début de piste avec mon programme, me reste à simuler les click sur les différentes boite de dialogues pour faire le téléchargement dans le dossier spécifié par programme.

Y a du boulot et c'est pas top comme solution mais bon si pas le choix