Hi Guys,
I have below code to download images from url in excel. Hence problem is not all files are downloading & I want to list those urls in another.
Sub dwl_front()
Dim ie As Object
lr = Cells(Rows.Count, 1).End(xlUp).Row
DPath = Sheet1.Range("F8").Value
If Len(Dir(DPath, vbDirectory)) = 0 Then
MsgBox "Enter a Valid Download Path", vbExclamation, "Error!"
Exit Sub
End If
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
sr = 6
er = Range("F9").Value + 1
'er = sr - 1
'DPath = Range("g5").Value
For i = sr To er
URL = ""
URL = Range("B" & i).Value
ie.navigate URL
Do While ie.Busy
DoEvents
Loop
Application.Wait (Now() + TimeValue("0:00:03"))
Application.SendKeys ("^s")
Application.Wait (Now() + TimeValue("0:00:06"))
'Filename:=fldrpth & "\" & "Churn Reminder - " & Format(Date, "dd-mm-yyyy") & "", FileFormat:=51
Application.SendKeys DPath & "\" & Range("A" & i).Value & ".JPEG"
Application.Wait (Now() + TimeValue("0:00:03"))
Application.SendKeys ("~")
Application.Wait (Now() + TimeValue("0:00:06"))
Next i
ie.Quit
MsgBox "Download Completed. Check Status"
End Sub
Thanks in Advance
I have below code to download images from url in excel. Hence problem is not all files are downloading & I want to list those urls in another.
Sub dwl_front()
Dim ie As Object
lr = Cells(Rows.Count, 1).End(xlUp).Row
DPath = Sheet1.Range("F8").Value
If Len(Dir(DPath, vbDirectory)) = 0 Then
MsgBox "Enter a Valid Download Path", vbExclamation, "Error!"
Exit Sub
End If
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
sr = 6
er = Range("F9").Value + 1
'er = sr - 1
'DPath = Range("g5").Value
For i = sr To er
URL = ""
URL = Range("B" & i).Value
ie.navigate URL
Do While ie.Busy
DoEvents
Loop
Application.Wait (Now() + TimeValue("0:00:03"))
Application.SendKeys ("^s")
Application.Wait (Now() + TimeValue("0:00:06"))
'Filename:=fldrpth & "\" & "Churn Reminder - " & Format(Date, "dd-mm-yyyy") & "", FileFormat:=51
Application.SendKeys DPath & "\" & Range("A" & i).Value & ".JPEG"
Application.Wait (Now() + TimeValue("0:00:03"))
Application.SendKeys ("~")
Application.Wait (Now() + TimeValue("0:00:06"))
Next i
ie.Quit
MsgBox "Download Completed. Check Status"
End Sub
Thanks in Advance