CODEWITHSUNDEEP
excelvba
Nick
Nick

Reputation: 775

Dealing with VBA Automation when searched values is not found

Using code provided in another post, I have slightly amended this to create a macro which looks up phrases searches for these using an online database (JECFA) to return a corresponding phrase (ADI) in the adjacent cell as shown below:

enter image description here

The code for this is:

Sub getADI()

Sheets("Sheet1").Select
Range("b3").Select

Do Until ActiveCell.Value = ""
    Call GetContent
Loop

End Sub


Public Sub GetContent()


    Const Url = "https://apps.who.int/food-additives-contaminants-jecfa-database/Search.aspx"
    Dim oHttp As Object, oHtml As HTMLDocument, MyDict As Object
    Dim DictKey As Variant, payload$, searchKeyword$
    
    Set oHtml = New HTMLDocument
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    Set MyDict = CreateObject("Scripting.Dictionary")
1
    'send get requests first to parse the value of "__VIEWSTATE", "__VIEWSTATEGENERATOR" e.t.c., as in oHtml.getElementById("__VIEWSTATE").Value
    
    With oHttp
        .Open "GET", Url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
        .send
        oHtml.body.innerHTML = .responseText
    End With
    
    searchKeyword = Selection.Value 'this is the search keyword you wanna use from your predefined search terms
    
    'MyDict stores keys and values within dictionary, as in __VIEWSTATE = "some string" and so on
    
    MyDict("__VIEWSTATE") = oHtml.getElementById("__VIEWSTATE").Value
    MyDict("__VIEWSTATEGENERATOR") = oHtml.getElementById("__VIEWSTATEGENERATOR").Value
    MyDict("__EVENTVALIDATION") = oHtml.getElementById("__EVENTVALIDATION").Value
    MyDict("ctl00$ContentPlaceHolder1$txtSearch") = searchKeyword
    MyDict("ctl00$ContentPlaceHolder1$btnSearch") = "Search"
    MyDict("ctl00$ContentPlaceHolder1$txtSearchFEMA") = ""

    'converting keys and values to a string joined with ampersand so that you can use it as a parameter while issuing post requests, which is what payload is doing
    
    payload = ""
    For Each DictKey In MyDict
        payload = IIf(Len(DictKey) = 0, WorksheetFunction.EncodeURL(DictKey) & "=" & WorksheetFunction.EncodeURL(MyDict(DictKey)), _
        payload & "&" & WorksheetFunction.EncodeURL(DictKey) & "=" & WorksheetFunction.EncodeURL(MyDict(DictKey)))
    Next DictKey
    
    With oHttp
        .Open "POST", Url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .send (payload)
        oHtml.body.innerHTML = .responseText
    End With
    
ActiveCell.Offset(0, 1).Value = oHtml.querySelector("#SearchResultItem > a").NextSibling.NodeValue

On Error Resume Next
ActiveCell.Offset(1, 0).Select



 
End Sub

This works well however I now wish to implement some sort of failsafe in case the phrase is not found.

So far I have just tried to implement On Error Resume Next at the end of Public Sub GetContent() however testing this with a made up phrase just returns an error regardless.

Ideally I wish to implement a phrase saying something like "Not found" but skipping to the next line regardless could also work.

Upvotes: 0

Views: 90

Answers (1)

Nicholas Hunter
Nicholas Hunter

Reputation: 1845

Don't use error handling when you can just test the return value of the function. If the function oHtml.querySelector("#SearchResultItem > a") returns Nothing if the value is not found, then test for that.

Set item = oHtml.querySelector("#SearchResultItem > a")
if item is Nothing then
    ' item not found
    ' maybe write log message and exit function?
else
    Set item = item.NextSibling
    if item is Nothing then
        ' no next sibling
        ' maybe write log message and exit function?
    else
        ActiveCell.Offset(0, 1).Value = item.NodeValue
    end if
end if

Upvotes: 1

Related Questions