' DellWarrantyInfo.vbs
' Description: Screen-scrape Dell warranty information based on a list of Service Tag numbers.
' Based on SMS Inventory script here: http://myitforum.com/cs2/blogs/skissinger/archive/2010/01/13/dell-warranty-information-script-small-update.aspx

' Input: Computers.txt, ASCII file with one Service Tag per line
' Output DellInventory.xlsx - Excel 2007 spreadsheet containing warranty information.

' DISCLAIMER: Use this script at your own risk. 

Dim objXL, objFSO,objShell, strCurrentDir, objTextFile

arrHeadings = Array("Service Tag:", "Days Left")

Set objHTTP = CreateObject("Msxml2.XMLHTTP")
Dim strField(400)
strfield(0) = Now

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set strCurrentDir = objFSO.GetFolder(".")

' Check if Computers.txt exists
If Not objFSO.FileExists(strCurrentDir & "\Computers.txt") Then
   MsgBox "Cannot find Computers.txt. Exiting."
   WScript.Quit
Else
   Set objTextFile = objFSO.OpenTextFile(strCurrentDir & "\Computers.txt")
End If 

' ///////////////////
' /// Main Module ///
' ///////////////////


' Create Excel spreadsheet for output
Set objXL = WScript.CreateObject("Excel.Application")
objXL.Visible = False
objXL.DisplayAlerts = False
' Create Spreadsheet
Set objWb = objXL.WorkBooks.Add 
    
' Add Heading information
objXL.ActiveSheet.Cells(1,1).Value="Service Tag"
objXL.ActiveSheet.Cells(1,2).Value="System Type"
objXL.ActiveSheet.Cells(1,3).Value="Ship Date"
objXL.ActiveSheet.Cells(1,4).Value="Dell IBU"
objXL.ActiveSheet.Cells(1,5).Value="Description"
objXL.ActiveSheet.Cells(1,6).Value="Provider"
objXL.ActiveSheet.Cells(1,7).Value="Warranty Extension Notification"
objXL.ActiveSheet.Cells(1,8).Value="Start Date"
objXL.ActiveSheet.Cells(1,9).Value="End Date"
objXL.ActiveSheet.Cells(1,10).Value="Days Left"

' Put cursor at A2
objXL.ActiveSheet.range("A2").Activate

intCount = 0
'Set objTextFile = objFSO.OpenTextFile(strCurrentDir & "\Computers.txt")
Do Until objTextFile.AtEndOfStream
	strServiceTag = objTextFile.ReadLine
	Call GetWarrantyInfo
	intCount = intCount + 1 'Running total of computers
Loop
objTextFile.Close

' Autofit spreadsheet data
Set xlRange = objXL.ActiveSheet.Range("A1:I" & intCount).CurrentRegion
xlRange.EntireColumn.AutoFit()

' Put cursor at A2
objXL.ActiveSheet.range("A2").Activate

' Save Spreadsheet
objXL.ActiveWorkbook.SaveAs strCurrentDir & "\DellInventoryReport.xlsx"
objXL.Application.Quit

WScript.Echo "Script complete."

' ///////////////////////
' /// GetWarrantyInfo ///
' ///////////////////////

Sub GetWarrantyInfo
'Get SerialNumber (Service Tag)
      strURL = "http://support.dell.com/support/topics/global.aspx/support/my_systems_info/details?c=us&l=en&s=gen&ServiceTag=" & strServiceTag & "&~tab=1"      
      objHTTP.open "GET", strURL, False
      objHTTP.send
      strPageText = objHTTP.responseText
      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(strInfoTable, "</td>")
'                  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), "<")
                              
                        Wend
                  Next
                  If LCase(arrCells(0)) = LCase("Service Tag:") Then
		  ' Parse Service tag, Ship Date
			' Service tag
 			objXL.ActiveCell.Value = arrCells(1)
			' System Type
 			objXL.ActiveCell.Offset(0,1).Value = arrCells(3)
			' Ship Date
 			objXL.ActiveCell.Offset(0,2).Value = arrCells(5)
			' Dell IBU
 			objXL.ActiveCell.Offset(0,3).Value = arrCells(7)

                  ElseIf LCase(arrCells(0)) = LCase("Description") Then
                  'WScript.Echo Join(arrCells, "|")
		  intRows = (intCell \ 6) - 1
		  ' Write specific support information (i.e. 4-hour on-site, etc)
		  ' First row of array will be "headings" info, so ignore
			For i = 1 to intRows
			' Description
 			objXL.ActiveCell.Offset(0,4).Value = arrCells((i * 6))
			' Provider
 			objXL.ActiveCell.Offset(0,5).Value = arrCells((i * 6) + 1)
			' Warranty Extension Notification?
 			objXL.ActiveCell.Offset(0,6).Value = arrCells((i * 6) + 2)
			' Start Date
 			objXL.ActiveCell.Offset(0,7).Value = arrCells((i * 6) + 3)
			' End Date
 			objXL.ActiveCell.Offset(0,8).Value = arrCells((i * 6) + 4)
			' Days Left
 			objXL.ActiveCell.Offset(0,9).Value = arrCells((i * 6) + 5)
 			' Skip to next row
			objXL.ActiveCell.Offset(1,0).Activate
		        Next
                  End If
            End If
      Next
End Sub