求职下标越界问题，程序已经运行出部分结果后出现这问题，实在找不出哪里有问题

godisboy

麻烦各位亲，帮忙看下，这段代码，已经有运行结果，因为数据比较多，运行一段就会出现下标越界。。看了好久，实在找不出哪里有问题
Sub test()
Dim keyword As String
Dim numonline As String
Dim url As String
Dim num As Integer
num = Application.CountA(Sheet1.Range("A:A"))
Dim linkname As String
linkname = "https://www.amazon.com/s/ref=nb_sb_noss?url=search-alias%3Daps&field-keywords="
Dim i As Integer
For i = 2 To num
    keyword = Replace(Sheet1.Range("A" & i), " ", "+")
        url = linkname & keyword
        numonline = getnum(url)
        Sheet1.Range("W" & i) = numonline

    Next

End Sub
Function getnum(ByVal url As String) As String
Dim ss As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", url, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .send
        Do Until .ReadyState = 4
                DoEvents
            Loop
        ss = .responsetext
        ss = Split(Split(ss, "<span id=""s-result-count"">")(1), "<span>")(0)
        ss = Replace(ss, "results for", "")
        getnum = ss
    End With
End Function

godisboy

有没那个大神救救命呀