Discussion :

[arnobo]

Bonjour,
je possède une liste d'url pour lesquelles je dois récupérer le code source de chacune des pages.
ex:
http://agence-prd.ansm.sante.fr/php/...e/N0254217.htm
sauriez vous m'aider, là je sèche totalement...

[Marc-L]

Bonjour,

un exemple parmi tant d'autres, chercher sur ce forum WebText …



______________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

[patricktoulon]

Bonjour
je viens de tester ta page web avec une requete et certain caracteres sont tarabiscotés

sinon avec ie ca fonctionne bien

exemple avec IE

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
Sub test()
Dim url As String
url = "http://agence-prd.ansm.sante.fr/php/ecodex/notice/N0254217.htm"
getpage url, True
End Sub
 
Function getpage(url, Optional MF As Boolean = False) As String
Dim REQ
Set REQ = CreateObject("internetexplorer.application")
REQ.navigate url
REQ.Visible = True
Do: DoEvents: Loop While REQ.readystate <> 4 Or REQ.busy
If MF = True Then
With CreateObject("htmlfile")
 If .parentWindow.clipboardData.setData("Text", REQ.document.body.innertext) Then
   req.quit           
 Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Cells(Rows.Count, 1).End(xlUp).Select
                .Paste
            Columns("A:A").AutoFit
 
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
 
End With
End If
End Function

sinon je te laisse quand meme la version avec une requete

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
Sub test()
Dim url As String
url = "http://agence-prd.ansm.sante.fr/php/ecodex/notice/N0254217.htm"
getpage url, True
End Sub
 
Sub getpage(url, Optional MF As Boolean = False)
Dim REQ
Set REQ = CreateObject("Microsoft.xmlhttp")
REQ.Open "POST", url, False
REQ.send
MsgBox REQ.responsetext
If MF Then
With CreateObject("htmlfile")
.write REQ.responsetext
 If .parentWindow.clipboardData.setData("Text", .body.innertext) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Cells(Rows.Count, 1).End(xlUp).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
 
End With
End If
End Sub

ta boucle sur les url dans la sub et incrementation des feuille dans la fonction a faire et adapter
salut