I am trying to use the below code to download a list of daily reports from password protected sites. The server seems to be blocking the request. I have no issues when manually logging in to download each report. I am using Excel 2013 and not positive that this is the correct WinHTTP reference to use or how to modify for use with newer versions, as the thread with the initial code is from 2008 (Haluk). Any advice to modify so that the server sees the request as it would when using a browser manually? I am spending extensive amounts of time to download 14 separate reports every day and really need to get this automated. Any help would be greatly appreciated.
Code:
Sub Download_All_Files()
Dim i As Long
Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
If Dir("C:\Users\Jennifer\Dropbox\Daily Payroll Reports", vbDirectory) = Empty Then MkDir "C:\Users\Jennifer\Dropbox\Daily Payroll Reports"
For i = 1 To 10
MyFile = Cells(i, 1).Text
If CheckURL(MyFile) Then
FileNum = FreeFile
Open "C:\Users\Jennifer\Dropbox\Daily Payroll Reports\LogFile.txt" For Append As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]
Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , MyFile & " --- Downloaded ----"
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]
TempFile = Right(MyFile, InStr(1, StrReverse(MyFile), "/") - 1)
WHTTP.Open "GET", MyFile, False
WHTTP.Send
FileData = WHTTP.ResponseBody
FileNum = FreeFile
Open "C:\Users\Jennifer\Dropbox\Daily Payroll Reports" & TempFile For Binary Access Write As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]
Put [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , 1, FileData
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]
Else
FileNum = FreeFile
Open "C:\Users\Jennifer\Dropbox\Daily Payroll Reports2\Confirmation.txt" For Append As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]
Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , MyFile & " !!! File Not Found !!!"
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]
End If
Next
Set WHTTP = Nothing
MsgBox "Open the folder [ C:\Users\Jennifer\Dropbox\Daily Payroll Reports ] for the downloaded files..."
End Sub
Function CheckURL(URL) As Boolean
'
'
'
Dim W As Object
On Error Resume Next
Set W = CreateObject("winhttp.winhttprequest.5")
If Err.Number <> 0 Then
Set W = CreateObject("winhttp.winhttprequest.5.1")
End If
On Error GoTo 0
On Error Resume Next
W.Open "HEAD", URL, False
W.Send
If W.Status = 200 Then
CheckURL = True
Else
CheckURL = False
End If
End Function
Last edited by a moderator: