Ca marche!!
Merci!
Voici le code:
Option Explicit
Option Base 1
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
Private Const ERROR_SUCCESS As Long = 0
Public Function Connection_Iview(str_Part As String, str_Description As String, str_Chemin As String, Optional str_Login As String "", Optional str_Mdp As String "")
Dim IE As InternetExplorer
Dim IEdoc As Object
Dim DOCelement As Object
Dim str_Link As String
Dim int_Start As Long
Dim int_Step As Long
Dim winShell As New ShellWindows
Dim str_UrlSearch() As String
Dim int_cpt As Integer
Dim str_Html As String
Dim sws As SHDocVw.ShellWindows
Dim bool_Error As Boolean
Select Case MsgBox("Attention, toutes les fenêtres IE vont être fermées (Internet, explorateur etc.)." _
& vbCrLf & "Continuer?" _
, vbYesNo Or vbQuestion Or vbDefaultButton2, "Continuer?")
Case vbYes
For int_cpt = 1 To 2
For Each IE In winShell
If IE.LocationURL <> "" Then
IE.Quit 'option pour les fermer
End If
Next IE
Next int_cpt
' str_Part = InputBox("Part à rechercher?", "Part", "6159326900")
If str_Chemin <> "" Then
str_Link = "http://xx.xx.xx.xx:xxxx/iview/iView"
Set IE = New InternetExplorer
IE.Visible = False
IE.Navigate str_Link
' attente de fin de chargement
Do Until IE.ReadyState = 4
DoEvents
Loop
Set IEdoc = IE.Document
'login
Set DOCelement = IEdoc.getElementsByName("USERNAME").Item
On Error Resume Next
DOCelement.Value = str_Login
'password
Set DOCelement = IEdoc.getElementsByName("password").Item
DOCelement.Value = str_Mdp
DOCelement.Select
'connexion
Set DOCelement = IEdoc.forms(0)
DOCelement.submit
Do Until IE.ReadyState = 4
DoEvents
Loop
On Error GoTo 0
str_Link = "http://xx.xx.xx.xx:xxxx/iview/iView?MODUL=HTML&HTML=simple_search.html"
IE.Navigate str_Link
Do Until IE.ReadyState = 4
DoEvents
Loop
Set DOCelement = IEdoc.getElementsByName("DRWNAME").Item
DOCelement.Value = str_Part
IE.Document.forms(0).submit.Click
Do Until IE.ReadyState = 4
DoEvents
Loop
str_Html = "http://xx.xx.xx.xx:xxxx/iview/iView"
Set sws = New SHDocVw.ShellWindows
While IEdoc.Title <> "Untitled Document"
For int_cpt = 0 To sws.Count - 1
If (Left(sws.Item(int_cpt).LocationURL, Len(str_Html)) str_Html) And (sws.Item(int_cpt).Document.Title) "Untitled Document" Then
Set IEdoc = sws.Item(int_cpt).Document
Exit For
End If
Next int_cpt
Wend
'MsgBox ("Titre de la page pointée: " & IEdoc.Title)
Set DOCelement = IEdoc.getElementsByTagName("a") ' "a" represente une collection d'objets "Element"
For int_cpt = 0 To DOCelement.Length - 1
If DOCelement(int_cpt).getAttribute("target") = "download" Then
ReDim Preserve str_UrlSearch(2, int_cpt + 11)
str_UrlSearch(1, int_cpt + 1) = (DOCelement(int_cpt).getAttribute("href")) 'ici "href" renvoi l'url recherchée. "href" est une propriété de "a"
End If
Next int_cpt
For int_cpt = 1 To UBound(str_UrlSearch, 2)
If str_UrlSearch(1, int_cpt) <> "" Then
' MsgBox str_Chemin & "" & Right(Left(str_UrlSearch(1, int_cpt), 50), 10) & Left(Right(str_UrlSearch(1, int_cpt), 31), 3) & int_cpt & Left(Right(str_UrlSearch(1, int_cpt), 21), 4)
DownloadFile _
str_UrlSearch(1, int_cpt), str_Chemin & "" & Right(Left(str_UrlSearch(1, int_cpt), 50), 10) & Left(Right(str_UrlSearch(1, int_cpt), 31), 3) & " " & str_Description & Left(Right(str_UrlSearch(1, int_cpt), 21), 4)
End If
Next int_cpt
For Each IE In winShell
If IE.LocationURL <> "" Then
IE.Quit 'option pour les fermer
End If
Next IE
If Err.Number <> 0 Then
MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description
End If
Else
MsgBox ("Pas de dossier séléctionné")
End If
Case vbNo
End Select
End Function
Public Function DownloadFile(ByVal sURL As String, _
ByVal sLocalFile As String) As Boolean
Dim lngRetVal As Long
DownloadFile = URLDownloadToFile(0&, sURL, _
sLocalFile, 0&, 0&) = ERROR_SUCCESS
End Function