Public Sub SaveFilesFromURL()
Dim mainURL As String, xxxURL As String, yyyURL As String, fSaveXXX As String, fSaveYYY As String
mainURL = "https://main
xxxURL = "https://xxx
yyyURL = "https://yyy
fSaveXXX = "C:\Users\... .xls" '//Change as required **make sure you give it a full path including a filename**
fSaveYYY = "C:\Users\... .xls"
'Fill in UserForm to submit Username and Password for main website
Do
UserForm.Show
'Log into main URL
Username= Range("BA1").Value
Password = Range("BA2").Value
strAuthenticate = "username=" & Username & "&password=" & Password & "&countryLocation=US" & "&submit=+working...+" & "&jsUTCOffset=420" '&jsUTCOffset=420 sets the time zone for my location.
Dim WHTTP As Object
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
WHTTP.Open "POST", mainURL, False
WHTTP.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
WHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/38.0.2125.104 Safari/537.36"
WHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WHTTP.send strAuthenticate
'To determine if logged in correctly, the cookies must be looked at. This could be different for any page though. WHTTP.getAllResponseHeaders is good for looking this up.
Dim strHeaders, hArr, kk, theCookie
strHeaders = WHTTP.getAllResponseHeaders
hArr = Split(strHeaders, vbCrLf)
Dim t, p, firstpos
For kk = 0 To UBound(hArr) - 1
t = hArr(kk)
If Mid(t, 1, Len("Set-Cookie: ")) = "Set-Cookie: " Then
firstpos = Len(t)
p = InStr(1, t, "CFID=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "CFTOKEN=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "JSESSIONID=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "; Path=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "; Domain=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "; Max-Age=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "; Secure=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "; Version=", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
p = InStr(1, t, "; HTTPOnly", vbTextCompare): If p > 0 And p < firstpos Then firstpos = p
theCookie = Mid(t, Len("Set-Cookie: ") + 1, firstpos - 1 - Len("Set-Cookie: "))
If cookie = "" Then
cookie = theCookie
Else
cookie = cookie & "; " & theCookie
End If
End If
Next
cookie = Trim(cookie)
'If EID or password are incorrect, re-enter information in UserForm.
Dim LogIn As Boolean
On Error Resume Next
If cookie = "" Then: LogIn = False: Else: LogIn = True
Err.Clear
On Error GoTo 0
Loop Until LogIn = True
'Then GET direct xxx file url
WHTTP.Open "GET", xxxURL, False
WHTTP.send
'Save the XXX file
Dim oStream As Object
xxxURL = WHTTP.responseBody
If WHTTP.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WHTTP.responseBody
oStream.SaveToFile fSaveXXX, 2 '// 1 = no overwrite, 2 = overwrite
oStream.Close
End If
'Then GET direct yyy file url
WHTTP.Open "GET", yyyURL, False
WHTTP.send
'Save the YYY file
yyyURL = WHTTP.responseBody
If WHTTP.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WHTTP.responseBody
oStream.SaveToFile fSaveYYY, 2 '// 1 = no overwrite, 2 = overwrite
oStream.Close
End If
Set WHTTP = Nothing
MsgBox "Files have been saved!", vbInformation, "Success"
End Sub
Display More
