Dell Warranty

[Andrewjames]

Hi, hope someone can help

I have the following working function to retrieve the Dell "Ship Date" from the dell Website, which can be found here

This works fine when the Warranty info is formatted with one line stating
"Next Business Day"

however returns a null when the Warranty info has more than one line, for example

"Next Business Day"
"Dell Business Support / ProSupport"

Two example links

One Line

Two Lines

[/URL]

Function GetWarranty(ByVal strCurrentTag)
        Dim objHTTP, strPageText, strURL, strHeading
        Dim intSummaryPos, intSummaryTableStart, intSummaryTableEnd, strInfoTable, arrCells, intCell, intOpenTag, intClosetag
        'Dim strNewCell, strCurrentTag, i, intField
        Dim strNewCell, i, intField, strShipDate
        Dim arrHeadings() = {"Service Tag:", "Days Left"}
 
        objHTTP = CreateObject("Msxml2.XMLHTTP")
        Dim strField(400)
        strField(0) = Now
        strPageText = ""
        strURL = "http://supportapj.dell.com/support/topics/topic.aspx/ap/shared/support/my_systems_info/en/details?c=in&cs=inbsd1&l=en&s=bsd&ServiceTag=" & strCurrentTag & "&~tab=1"
        'strURL = "http://support.dell.com/support/topics/global.aspx/support/my_systems_info/details?c=us&l=en&s=k12&servicetag=" & strCurrentTag
        objHTTP.open("GET", strURL, False)
        objHTTP.send()
        strPageText = objHTTP.responseText
        'MsgBox(arrHeadings.Length)
 
        For Each strHeading In arrHeadings
            intSummaryPos = InStr(LCase(strPageText), LCase(strHeading))
            If intSummaryPos > 0 Then
                intSummaryTableStart = InStrRev(LCase(strPageText), "<table", intSummaryPos)
                intSummaryTableEnd = InStr(intSummaryPos, LCase(strPageText), "</table>") + 8
                strInfoTable = Mid(strPageText, intSummaryTableStart, intSummaryTableEnd - intSummaryTableStart)
                strInfoTable = Replace(Replace(Replace(strInfoTable, vbCrLf, ""), vbCr, ""), vbLf, "")
                arrCells = Split(LCase(strInfoTable), "</td>")
 
                For intCell = LBound(arrCells) To UBound(arrCells)
                    arrCells(intCell) = Trim(arrCells(intCell))
                    intOpenTag = InStr(arrCells(intCell), "<")
 
                    While intOpenTag > 0
                        intClosetag = InStr(intOpenTag, arrCells(intCell), ">") + 1
                        strNewCell = ""
                        'If intOpenTag > 1 Then strNewCell = strNewCell & Trim(Left(arrCells(intCell), intOpenTag - 1))
                        If intClosetag < Len(arrCells(intCell)) Then strNewCell = strNewCell & Trim(Mid(arrCells(intCell), intClosetag))
 
                        arrCells(intCell) = Replace(Trim(strNewCell), " &nbsp;&nbsp;&nbsp;&nbsp;change service tag", "")
                        intOpenTag = InStr(arrCells(intCell), "<")
 
                    End While
                Next
 
                If LCase(arrCells(0)) = LCase("Service Tag:") Then
                    strCurrentTag = ""
 
                    i = 0
 
                    For intField = 1 To UBound(arrCells) Step 2
                        i = i + 1
                        strField(i) = arrCells(intField)
                    Next
 
                ElseIf LCase(arrCells(0)) = LCase("Description") Then
                    i = 0
 
                    For intField = 5 To UBound(arrCells)
                        strCurrentTag = strCurrentTag & ",""" & arrCells(intField) & """"
                        i = i + 1
                        strField(i) = arrCells(intField)
                    Next
                End If
 
            Else
 
                strShipDate = "No Info"
                Return strShipDate
 
                End
 
            End If
        Next
 
        strShipDate = strField(8)
 
        Return (strShipDate)
 
    End Function