Place the following in a module. Later you can assign PPIDtest to a button
but for now just run it with F5. Better still, while figuring it out put the
cursor in PPIDtest and keep pressing F8.
The first time I had to be patient and eventually a security certificate
prompt popped up that I had to dismiss. First time suggest you only select
one cell with a barcode
Sub PPIDtest()
Dim sCode As String
Dim sReply As String
Dim rng As Range
On Error Resume Next
Set rng = Application.InputBox("Select PPID cells in a column", _
"PPIDtest", _
Selection.Address, _
Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub ' user cancelled
If rng.Columns.Count > 1 Then Exit Sub '2+ columns selected
If rng.Rows.Count > 100 Then
'best to set some aribtary limit
MsgBox "Limit set at 100"
Exit Sub
End If
On Error GoTo errH
For Each cel In rng
sCode = cel.Text
sReply = GetPPID(sCode)
cel.Offset(0, 1).Value = sReply
Next
Exit Sub
errH:
MsgBox Err.Description
End Sub
Function GetPPID(PPID) As String
Const URL As String = _
"
https://report.converge.com/dell/internal/check_battery.php?ppid="
Const FRAG1 As String = "'green'>"
Const FRAG2 As String = "</FONT>"
Dim msxml As Object
Dim rV, tmp, pos1, pos2
rV = ""
If PPID <> "" Then
Set msxml = CreateObject("Microsoft.XMLHTTP")
msxml.Open "Get", URL & PPID, False
msxml.send
tmp = msxml.responseText
pos1 = InStr(tmp, FRAG1)
pos2 = InStr(tmp, FRAG2)
' If pos1 > 0 And pos2 > 0 Then
' rV = Left(tmp, pos2 - 1)
' rV = Right(rV, Len(rV) - (pos1 + Len(FRAG2)))
' End If
rV = tmp ' to be parsed later
Set msxml = Nothing
End If
GetPPID = rV
' example of return string to be parsed
'
[BR][BR][BR][BR][FONT COLOR='green']
' PPID: THE-BARCODE-HERE: KEEP AT CONVERGE![/FONT][BR]
' [BR]
[BR][BR][FORM ACTION = 'check_battery.php']PPID:
' [INPUT TYPE='text' NAME = 'ppid'][BR][BR][INPUT TYPE='SUBMIT'
' VALUE = ' SUBMIT '][/FORM]
End Function
You will need to decide how to parse potential return strings for yourr own
needs, presumably you won't want the entire string as in the above example.
Regards,
Peter T
