Bonjour,
je bloque pour effectuer une macro sous excel

situation :
Je dois me connecter sur un site web avec authentification. ==> OK
Une fois authentifié j'arrive à une page HTML avec frame très mal formatée où il y a un nombre important de form sans name, sans nom ..
en fait ce sont des icone submit pour avec parametre pour télécharger des fichiers excels avec des données. ==> KO

je veux donc m'authentifier et récupérer sur mon poste le fichier excel pour ensuite l'ouvrir et copier/coller une zone d'une feuille dans le doc excel en cours.

Avec le code suivant j'arrive à m'authentifier mais pas a récupérer le fichier
j'ai mis en constante DOC_EXCEL, l'url que je peux mettre une fois authentifier pour déclencher le téléchargement.

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
 '''Library SHDocVw
'''C:\WINDOWS\system32\ieframe.dll\1
'''Microsoft Internet Controls
 
Const MY_URL As String = "http://nom_du_site/XReportWeb/Login.aspx"
Const DOC_EXCEL As String = "http://nom_du_site/XReportWeb/Aspx/Private/Views.aspx?=excel&export=335"
Const IDENTIFIANT As String = "profil"
Const PASS As String = "mot_de_passe"
Const CheminRep As String = "c:\Logo\doc.xls"
 
 
 
Sub PiloterInternet()
Dim IE As Object  'SHDocVw.InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
With IE
  .Silent = False
  .Navigate MY_URL
  Do Until .ReadyState = 4
    DoEvents
  Loop
  .document.all("txtUserName").Value = IDENTIFIANT
  .document.all("txtPassword").Value = PASS
  .document.all("btnAuthenticate").Click
  .Visible = True
   SaveHtmlFile DOC_EXCEL, CheminRep
End With
Set IE = Nothing
End Sub
 
Sub SaveHtmlFile(aUrl As String, aDestination As String)
'Pris sur le forum de la msdn (avec quelques menues modifs)
'http://social.msdn.microsoft.com/Forums/en/isvvba/thread/bd0ee306-7bb5-4ce4-8341-edd9475f84ad
Dim WinHttpReq As Object, oStream As Object
Dim TheURL As String
 
   On Error Resume Next 'On ne gère pas les erreurs
 
   Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
   WinHttpReq.Open "GET", aUrl, False
   WinHttpReq.send
 
   TheURL = WinHttpReq.responseBody
 
   If WinHttpReq.Status = 200 Then
      Set oStream = CreateObject("ADODB.Stream")
      oStream.Open
      oStream.Type = 1
      oStream.Write WinHttpReq.responseBody
      oStream.SaveToFile aDestination
      oStream.Close
   End If
End Sub

Merci pour votre aide car je début en VBA et je ne vois pas où cela bloque