Downloading all files with the prefix from the website in VBA

I have a website where there are 100 links to csv files that are automatically downloaded after clicking. Each of the files has a prefix in the form aaa_.
The following standard code allows you to save a file based on the URL to the selected location on the disk:

aaa_

Sub Download_from_website()

Dim myURL As String
myURL = "https://mysite/2500/csv/aaa_1.csv"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:UserstkpDesktopdownload_from_websiteaaa_1.csv")
oStream.Close
End If

End Sub


How can you transform the above code so that you can automatically search the web page to find all links in which the string aaa_ appears and automatically save in the selected location? I will be very grateful for any tips.

aaa_

The above code was a simplified example of what I would like to get. However, in fact I would like to save all the files that have the SEB_ prefix from the site
https://sebgroup.lu/private/luxembourg-based-funds/download-of-portfolio-holdings

SEB_

string aaa_ appears

have the SEB_ prefix

2 Answers
2

Give the following script a go. I suppose it will fix the issues you are having now. I've written this script considering the fact that you want all the csv files which have seb in their links.

seb

Here you go:

Sub DownloadFilesFromWeb()
Const URL As String = "https://sebgroup.lu/private/luxembourg-based-funds/download-of-portfolio-holdings"
Dim Http As New WinHttp.WinHttpRequest, Html As New HTMLDocument, I&, tempArr As Variant

With Http
.Open "GET", URL, False
.send
Html.body.innerHTML = .responseText
End With

With Html.querySelectorAll(".linklist a[href*='seb']")
For I = 0 To .Length - 1
tempArr = Split(.item(I).getAttribute("href"), "/")
tempArr = tempArr(UBound(tempArr))

Http.Open "GET", .item(I).getAttribute("href"), False
Http.send

With CreateObject("ADODB.Stream")
.Open
.Type = 1
.write Http.responseBody
''notice the following line how the "tempArr" should be appended to the folder you have
.SaveToFile "C:UsersWCSDesktopdownloadfile" & tempArr
.Close
End With
Next I
End With
End Sub


Reference to add to the library:

Microsoft HTML Object Library
Microsoft WinHTTP Services, version 5.1


This should manage them

Option Explicit

#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr _
) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
#End If

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub GetLinks()
Dim sResponse As String, html As New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://sebgroup.lu/private/luxembourg-based-funds/download-of-portfolio-holdings", False
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With

sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))

With html
.body.innerHTML = sResponse
Dim list As Object, i As Long
Set list = html.getElementsByClassName("linklist")(0).getElementsByTagName("a")
For i = 0 To list.Length - 1
If instr(list(i).getAttribute("href"),"SEB_") > 0 Then
downloadfile list(i).getAttribute("href")
End If
Next i
End With
End Sub

Public Sub downloadfile(ByVal url As String)
Dim fileName As String, fileNames() As String, folderName As String
fileNames = Split(url, "/")
fileName = fileNames(UBound(fileNames))
folderName = "C:UsersUserDesktopCurrentDownloads" & fileName '<==change as required
Dim ret As Long
ret = URLDownloadToFile(0, url, folderName, BINDF_GETNEWESTVERSION, 0)
End Sub


By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.