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
|
Sub Test2()
Dim myIE As Object
Dim Doc As Object
Dim items As Object
Dim Item As Object
Dim srcPath As String
Dim srcName As String
Set myIE = CreateObject("InternetExplorer.Application")
myIE.navigate "https://msu.edu/~urban/sme865/resources/embedded_pdf.html"
myIE.Visible = True
Call WaitWeb(myIE)
Set Doc = myIE.document
Set items = Doc.getElementsByTagName("embed") '.getellementbyid("embed")
Set Item = items(0)
srcPath = Item.src
srcName = Mid(srcPath, InStrRev(srcPath, "/") + 1)
Call DownloadFile(srcPath, "C:\" & srcName)
myIE.Quit
End Sub
Private Sub WaitWeb(ByRef IE As Object)
' Parameter: Web Browser info
Do
DoEvents
Loop While IE.Busy Or (IE.readyState <> 4)
End Sub
Sub DownloadFile(ByVal myURL As String, ByVal myFilePath As String)
' First parameter : location of the file on the internet
' Second parameter: location of the file on the PC
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False ', "username", "password"
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1 ' 1 = binary, 2=type
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile myFilePath, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub |
Partager