what I am trying to do is use VBA code, or any way actually to lookup a website and pull a CPU model found by using the Id I assume. I then need it to take that CPU model and Paste it into the Corresponding Cell in excel.
here are my examples.
I need the website https://partsurfer.hpe.com/Search.aspx?SearchText= to be pulled up with the cell from S/N to be appended right after the = it then pulls a website with the hardware information. and line 33 is the cpu model. I need that populated into the CPU cell corresponding to the Serial number.
a serial number to test with MXQ2040F21
CodePudding user response：
Here's a version that combines the cell iteration and the more robust web fetch from my prior two attempts.
Sub get_computer_data()
' be sure to set these two constants and a variable
Dim SheetName As String
SheetName = "computers" ' name of the sheet that has the computer data
Dim serialNumCol As Byte
serialNumCol = 4 ' the number of the column that has the serial number
Dim r As Long: r = 2 ' the row the computer data starts on
Dim s As Worksheet
Set s = ThisWorkbook.Worksheets(SheetName) 'process a specific sheet
' process all rows of contiguous data
Do Until s.Cells(r, 1).Value = ""
s.Cells(r, serialNumCol 2).Value = get_processor(s.Cells(r, serialNumCol).Value)
r = r 1
Loop
End Sub
Function get_processor(serial_number) As String
Dim position As Long
Dim search As String
Dim processor As String
Dim html As String
Const url = "https://partsurfer.hpe.com/Search.aspx?SearchText="
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
xmlhttp.Open "POST", url & serial_number, False
xmlhttp.Send
html = xmlhttp.responseText
' find the tag that idenifies the processor in the html
search = "ctl00_BodyContentPlaceHolder_gridCOMBOM_ctl34_lblpartdesc1"">"
position = InStr(1, html, search) Len(search)
if position = 0 then
get_processor = "not found"
else
processor = Split(Mid(html, position), "<")(0)
get_processor = processor
end iff
End Function
CodePudding user response：
Here's an approach to get get the data you are after using a more direct method than the web query method in my other answer. This function takes a serial number and returns the processor.
Sub test()
Debug.Print get_processor("MXQ2040F21")
End Sub
Function get_processor(serial_number) As String
Dim position As Long
Dim search As String
Dim processor As String
Dim html As String
Const url = "https://partsurfer.hpe.com/Search.aspx?SearchText="
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
xmlhttp.Open "POST", url & serial_number, False
xmlhttp.Send
html = xmlhttp.responseText
' find the tag that idenifies the processor in the html
search = "ctl00_BodyContentPlaceHolder_gridCOMBOM_ctl34_lblpartdesc1"">"
position = InStr(1, html, search) Len(search)
processor = Split(Mid(html, position), "<")(0)
get_processor = processor
End Function
CodePudding user response：
The code below uses Excel's built-in "web query" feature to pull the as you have described. This code brings in the value from the 33rd row of the table that comes back from the web request. However, I'm skeptical that the CPU data will always be on the 33rd row and I don't see a way based on results from the webserver to infer what the right line is. Hopefully, this gets you headed in the right direction.
Sub get_computer_data()
' be sure to set these two constants and a variable
Dim SheetName as String
SheetName = "computers" ' name of the sheet that has the computer data
Dim serialNumCol as Byte
serialNumCol = 5 ' the number of the column that has the serial number
Dim r As Long: r = 2 ' the row the computer data starts on
Dim url as String
url = "https://partsurfer.hpe.com/Search.aspx?SearchText="
Dim s As Worksheet ' a reference
Dim query As Worksheet ' a variable to refer to the sheet created by the web query
Dim cell As Range ' a range object used to find data in the query result
Set s = ThisWorkbook.Worksheets(SheetName) 'process a specific sheet
' process all rows of contiguous data
Do Until s.Cells(r, 1).Value = ""
'perform a web query for the current serial number
Set query = CreateWebQuery(url & s.Cells(r, serialNumCol).Value, xlAllTables)
' find the data on the result page
Set cell = query.Cells.Find("Part Description", , , xlWhole)
If cell Is Nothing Then
s.Cells(r, serialNumCol 2).Value = "No Data"
Else
s.Cells(r, serialNumCol 2).Value = cell.Offset(33)
End If
r = r 1
Loop
End Sub
Function CreateWebQuery(url As String, Optional WebSelectionType As XlWebSelectionType = xlEntirePage, Optional SaveQuery As Boolean, Optional PlainText As Boolean = True, Optional SheetName As String = "webQuery") As Worksheet
'*********************************************************************************'
' Builds a web-query object to retrieve information from a web server and
' returns a reference to a worksheet containing the data
'
' Parameters:
'
'
' URL
' The webpage to get. Should start with "http"
'
' WebSelectionType (xlEntirePage or xlAllTables)
' what part of the page should be brought back to Excel.
'
' SaveQuery (True or False)
' Indicates if the query object remains in the workbook after running
'
' PlainText (True or False)
' Indicates if the query results should be plain or include formatting
'
' SheetName
' Indicates the name of the sheet to create or use
'
'*********************************************************************************'
Dim outsheet As Worksheet
Dim s As Worksheet
Set s = ActiveSheet
On Error Resume Next
Set outsheet = ThisWorkbook.Worksheets(SheetName)
If Err.Number = 0 Then
outsheet.Cells.Clear
Else
Set outsheet = ThisWorkbook.Worksheets.Add
outsheet.Name = SheetName
End If
On Error GoTo 0
s.Activate
With outsheet.QueryTables.Add(Connection:="URL;" & url, Destination:=outsheet.Range("a1"))
.Name = "WebQuery"
.RefreshStyle = xlOverwriteCells
.WebSelectionType = WebSelectionType
.PreserveFormatting = PlainText
.BackgroundQuery = False
.Refresh
If Not SaveQuery Then .Delete
End With
Set CreateWebQuery = outsheet
End Function