Need a macro for clicking all the URL's present under one column

[moramramesh]

I have some random number of hyper links under column G. Clicking a link will open internet explorer downloads dialog box and asks to choose whether to open or save the CSV file. When clicking save button, csv file will be saved to default downloads folder.

Here I need a macro to automatically click on each URL hyperlink present under column G and save the csv file.

Is it also possible to save the csv file in any specific location and with the name we want which is present in the column H? (by default file will be saved with some random name)

 

[moramramesh]

I tried using the below code but it is overwriting the previous content and not appending. Can someone please modify the code so that next content will be appended.

Sub Macro1()


Dim i As Long
Dim myURL As String


For i = 1 To Sheet2.Range("A1:A3").Rows.Count
myURL = Sheet2.Cells(i, 1).Value


Dim HttpReq As Object
Set HttpReq = CreateObject("Microsoft.XMLHTTP")
HttpReq.Open "GET", myURL, False
HttpReq.send
myURL = HttpReq.responseBody
Set oStrm = CreateObject("ADODB.Stream")
oStrm.Open
oStrm.Type = 1
oStrm.Write = HttpReq.responseBody
oStrm.SaveToFile "I:" & "SampleFile.csv", 2 ' 1 = no overwrite, 2 = overwrite (Here I'm getting error if trying to use 1)
oStrm.Close
Next i

End Sub

 

[pbornemeier]

Sent a few valid URLs and I can test the code, but I think this should work

Option Explicit

Sub Macro1()
    'https://www.mrexcel.com/forum/general-excel-discussion-other-questions/1098904-need-macro-clicking-all-urls-present-under-one-column.html
    'More XMLHTTP help here:
        'https://javascript.info/xmlhttprequest
        'https://developer.mozilla.org/en-US/docs/Web/HTTP/Status

    Dim i As Long
    Dim myURL As String
    Dim HttpReq As Object
    Dim sFileName As String
    Dim sFolderName As String
    Dim wks As Worksheet
    Dim oStrm As Object
    
    Set wks = Worksheets("Sheet2")

    'Last save folder will be in effect
    sFolderName = Environ("USERPROFILE") & "\Documents\"    'This would save in the Documents folder of the current user
    sFolderName = "I:"      'This would save the file in the current default folder for I
    sFolderName = "I:\"     'This would save the file in the root directory of I

    For i = 1 To wks.Range("A1:A3").Rows.Count
        myURL = wks.Cells(i, 1).Value
        Set HttpReq = CreateObject("Microsoft.XMLHTTP")
        sFileName = wks.Cells(i, 8).Value    'Filename from column H of same row

        HttpReq.Open "GET", myURL, False
        HttpReq.send
        'May want to add this test
'        If HttpReq.Status <> 200 Then MsgBox
'            MsgBox "HTTP Status: " & HttpReq.Status & " " & HttpReq.Statustext
'        Else
            '200 means OK
            myURL = HttpReq.responseBody
            Set oStrm = CreateObject("ADODB.Stream")
            oStrm.Open
            oStrm.Type = 1
            oStrm.Write = HttpReq.responseBody
            oStrm.SaveToFile sFolderName & sFileName, 1 ' 1 = no overwrite, 2 = overwrite (Here I'm getting error if trying to use 1)
            oStrm.Close
'        End If
    Next i

End Sub