How to Save File from Webpage using VBA

[leigh123]

Hi, I am working on a code to extract open a webpage, click on a hyperlink to an excel file, save the file under a specific name in a specific folder and open it to copy it to my workbook. Below is my code. So far, I've been able to get to the open/save as link at the bottom of the webpage, but I can't figure out how to save it under a specific name and in the current folder that it is in. Any help is appreciated!


Option Explicit

#If VBA7 Then

Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" ( _
ByVal pcaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwreserved As LongPtr, _
ByVal lpfnCB As LongPtr) As LongPtr

#Else
Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" ( _
ByVal pcaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwreserved As Long, _
ByVal lpfnCB As Long) As Long
#End If

Sub Browse_To_Site_Early_Binding()

'Open Webpage
Dim IE As Object
Dim Destinationfile As String
Dim AllHyperlinks As Object
Dim hyper_link As Object
Dim FileURL As String

Dim newHour As Integer
Dim newMinute As Integer
Dim newSecond As Integer
Dim waitTime As Integer

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

IE.navigate "Part Number Lookup and Parts Pricing Calculator"
Do
DoEvents
Loop Until IE.readyState = 4


'Activate Hyperlinks
Set AllHyperlinks = IE.document.getElementsByTagName("A")
For Each hyper_link In AllHyperlinks
If hyper_link.innerText = "Here" Then
hyper_link.Click
Exit For
End If
Next

'Waiting for page to become interactive
Do
DoEvents
Loop Until IE.readyState <> 3


'Waiting for page to be complete
Do
DoEvents
Loop Until IE.readyState > 3

Application.Wait Now + TimeValue("00:00:03")
SendKeys "%{s}"

Destinationfile = "C:\Users\amber\Documents\VBA\VBA Download.xlsx"

If URLDownloadToFileA(0, 0, Destinationfile, 0, 0) = 0 Then
Debug.Print "File Download Started"
Else
Debug.Print "File Download Not Started"
End If

End Sub

 

[Anthony47]

Try this version:

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" ( _
    ByVal pcaller As LongPtr, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwreserved As LongPtr, _
    ByVal lpfnCB As LongPtr) As LongPtr
#Else
    Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" ( _
    ByVal pcaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwreserved As Long, _
    ByVal lpfnCB As Long) As Long
#End If

Sub Browse_To_Site_LATE_Binding()       '
'Open Webpage
Dim IE As Object
Dim Destinationfile As String, myFile As String, Resp
Dim AllHyperlinks As Object
Dim hyper_link As Object
'Dim FileURL As String

'Dim newHour As Integer
'Dim newMinute As Integer
'Dim newSecond As Integer
'Dim waitTime As Integer
'
Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .Visible = True
    .navigate "https://www.milwaukeetool.com/Support/PartsPricing"
        DoEvents
        Do While .Busy: DoEvents: Loop    'Attesa not busy
        Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
End With
'
'Search for Hyperlinks
Set AllHyperlinks = IE.document.getElementsByTagName("A")
For Each hyper_link In AllHyperlinks
    If hyper_link.innerText = "Here" Then
        myFile = hyper_link.href & ".xls"       '
        Exit For
    End If
Next
'
If myFile <> "" Then
    Destinationfile = "C:\Users\amber\Documents\VBA\VBA Download.xlsx"
    'Destinationfile = "C:\PROVA\VBA Download.xlsx"
    Resp = URLDownloadToFileA(0, myFile, Destinationfile, 0, 0)
    Application.Wait Now + TimeValue("00:00:01")
    If Resp = 0 Then
        MsgBox ("Imported:" & vbCrLf & Destinationfile)
    Else
        MsgBox ("Download failed: " & myFile)
    End If
Else
    MsgBox ("File to download not found")
End If
'
IE.Quit
Set IE = Nothing
End Sub