Part 2: Send HTTP request for each row in Excel table

Question

This script was previously reviewed here: Send HTTP request for each row in Excel table (Part 1)

I've made the changes that were suggested in the Code Review answers as well as added a few of my own.

The code is quite a bit different now. Are there any more improvements that should be made?

---

Description:

1. A custom function concatenates columns with parameters into the Concatenated Variables column.
2. Loops through each row in the table where Load? = y
3. Sends an HTTP request to an external system using the value in the URL column.
4. Returns a message (created, updated, or problem/error) and stores it in the Message column.

---

New code:

Option Explicit

Public Const tblName = "tblData"
Public Const colNameLoad = "Load?"
Public Const colNameMessage = "Message"
Public Const colNameURL = "URL"
Public Const colNameTimestamp = "Message Timestamp"

Function CodeName() As Worksheet
Set CodeName = DataSheet
End Function

Public Sub LoadRecords()
    Application.CalculateFull
    Dim message As String, response As String
    Dim n As Long
    
    'Keep an eye on unecessary calls to the ConcatVars function.
    With CodeName.ListObjects(tblName)
        .ListColumns(colNameMessage).Range.Interior.Color = rgbWhite
        .ListColumns(colNameMessage).Range.Font.Color = rgbLightGrey
        For n = 1 To .ListRows.Count
            If UCase(.ListColumns(colNameLoad).DataBodyRange(n).Value) = "Y" Then
                response = GetHTTP(.ListColumns(colNameURL).DataBodyRange(n).Value)
                .ListColumns(colNameMessage).DataBodyRange(n) = response
                .ListColumns(colNameMessage).DataBodyRange(n).Font.Color = rgbBlack
                .ListColumns(colNameTimestamp).DataBodyRange(n) = Now()
            
                With .ListColumns(colNameMessage).DataBodyRange(n)
                    message = Left(response, 7)
                    .Interior.Color = Switch(message = "Created", rgbLightGreen, message = "Updated", rgbSkyBlue, message = "Problem", rgbYellow, True, rgbOrangeRed)
                End With
            
            End If
        Next
    End With
End Sub

Public Function GetHTTP(ByVal url As String) As String

On Error GoTo ConnectionError:

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False: .Send
        GetHTTP = VBA.StrConv(.responseBody, vbUnicode)
    End With

On Error GoTo 0
Exit Function
ConnectionError:
GetHTTP = "Problem with URL or server: " & Err.Number & " " & Err.Description

End Function

Function ConcatVars(RowNum As Integer) As String
    Dim Column As ListColumn
    Dim s As String

    For Each Column In CodeName.ListObjects(tblName).ListColumns
        If Column.Name Like "f_*" Then
            s = s & IIf(Len(s) > 0, "&", "") _
                & Mid(Column.Name & "=" & Column.Range.Cells(RowNum).Value, 3)
        End If
    Next
    ConcatVars = s
End Function

---

I have a follow-up question here: Create or update record via HTTP request (Python/Jython).

Answer 1

Your code is pretty solid. I so have a couple of minor tweaks.

Function CodeName() As Worksheet
Set CodeName = DataSheet
End Function

This function is just adding a layer obfuscation. You should just change the worksheets code name.

• Ctrl + R will Open the Folder Explorer
• Alt + F4

From here you can change the Worksheet's Name property.

Combining lines should be avoided. It detracts from the readability of the code. I am not opposed to declaring a variable and initiating its value in one line but only because you are allowed to assign values when declaring variables in most other languages.

Dim Target as Range: Set Target = Sheet1.Range("A1")

Here you are combing two actions into a single line. Not only does it make it harder to read but it may run into problems later on when you are writing similar code.

.Open "GET", url, False: .Send

Consider for instance that weeks down the you are having problems writing a new function because you forgot to .Send your request. So what do you do? You reference your code base. Combing the .Open and .Send request into one line makes it hard to distinguish the ↑code above↑ from the ↓code below↓.

.Open "GET", url, False

Although you never asked about speed I think its worth mentioning.

Adding Application.ScreenUpdating = False to the beginning of your code will make it run considerably faster.

Setting the varAsync parameter of the MSXML2.XMLHTTP.Open() method to True will allow the rest of the code to run while the HTTP XMLHTTP.Request() is processing. This will allow you to create more connections. Having 50 or more connections processing at once will greatly sped up the code.

Sub open(bstrMethod As String, bstrUrl As String, [varAsync], [bstrUser], [bstrPassword])

---

In my answers to the questions below I create a connection pool. I initiate the pool with x number of connections. As the requests are completed the newly freed connection is given a new request.

Shameless plug:

• Data scraping from Internet with Excel-VBA
• Retrieve data from eBird API and create multi-level hierarchy of locations

In truth, setting up a connection pool, is probably over kill. But it is nice to know that it can be done in case you every need the extra speed boast.