Hello
I have a vba userform with all the printers of my company (mono or colour printers) , and now i'm triyng to get the toner level ( only to display the remaining toner in percentage ) without no success
I've tried several approaches , i created a button Get toner , when i click , the 4 textboxes (if printer is colour ) created don't get populate with the information
The code i have is this
Private Sub GetToner_Click()
' Get the IP address from TextBox2
Dim ipAddress As String
ipAddress = TextBox2.Value
' Get the HTML content from the printer's web page
Dim htmlContent As String
htmlContent = GetHTMLContent("http://" & ipAddress)
' Extract toner levels from the HTML content
Dim tonerLevels() As String
tonerLevels = ExtractTonerLevels(htmlContent)
' Update the TextBoxes with toner levels
TextBox5.Value = tonerLevels(0) ' Cyan Toner Level
TextBox6.Value = tonerLevels(1) ' Magenta Toner Level
TextBox7.Value = tonerLevels(2) ' Yellow Toner Level
TextBox8.Value = tonerLevels(3) ' Black Toner Level
End Sub
Private Function ExtractTonerLevels(ByVal html As String) As String()
Dim doc As Object
Set doc = CreateObject("HTMLFile")
doc.body.innerHTML = html
Dim tonerLevels(0 To 3) As String
' Cyan Toner Level
Dim cyanElements As Object
Set cyanElements = doc.getElementsByTagName("b")
Dim i As Integer
For i = 0 To cyanElements.Length - 1
If cyanElements(i).innerText = "Cartucho ciano" Then
Dim cyanLevel As String
cyanLevel = cyanElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(0) = Mid(cyanLevel, 1, Len(cyanLevel) - 1)
Exit For
End If
Next i
' Magenta Toner Level
Dim magentaElements As Object
Set magentaElements = doc.getElementsByTagName("b")
For i = 0 To magentaElements.Length - 1
If magentaElements(i).innerText = "Cartucho magenta" Then
Dim magentaLevel As String
magentaLevel = magentaElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(1) = Mid(magentaLevel, 1, Len(magentaLevel) - 1)
Exit For
End If
Next i
' Yellow Toner Level
Dim yellowElements As Object
Set yellowElements = doc.getElementsByTagName("b")
For i = 0 To yellowElements.Length - 1
If yellowElements(i).innerText = "Cartucho Amarelo" Then
Dim yellowLevel As String
yellowLevel = yellowElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(2) = Mid(yellowLevel, 1, Len(yellowLevel) - 1)
Exit For
End If
Next i
' Black Toner Level
Dim blackElements As Object
Set blackElements = doc.getElementsByTagName("b")
For i = 0 To blackElements.Length - 1
If blackElements(i).innerText = "Cartucho Preto" Then
Dim blackLevel As String
blackLevel = blackElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(3) = Mid(blackLevel, 1, Len(blackLevel) - 1)
Exit For
End If
Next i
ExtractTonerLevels = tonerLevels
End Function
Function FindElementByTagNameAndAttribute(doc As Object, tagName As String, attributeName As String, attributeValue As String) As Object
' Find the first element in the document that matches the specified tag name and attribute
Dim elements As Object
Set elements = doc.getElementsByTagName(tagName)
Dim element As Object
For Each element In elements
If element.getAttribute(attributeName) = attributeValue Then
Set FindElementByTagNameAndAttribute = element
Exit Function
End If
Next element
' Return Nothing if no matching element is found
Set FindElementByTagNameAndAttribute = Nothing
End Function
Private Function GetElementByInnerText(ByVal elements As Object, ByVal innerText As String) As Object
Dim i As Integer
For i = 0 To elements.Length - 1
If elements(i).innerText = innerText Then
Set GetElementByInnerText = elements(i)
Exit Function
End If
Next i
Set GetElementByInnerText = Nothing
End Function
Private Function GetTonerLevelFromElement(ByVal element As Object) As String
Dim tableElement As Object
Set tableElement = element.parentElement.parentElement.parentElement.getElementsByTagName("table")(1)
If Not tableElement Is Nothing Then
GetTonerLevelFromElement = Mid(tableElement.Rows(1).Cells(0).Title, 1, Len(tableElement.Rows(1).Cells(0).Title) - 1)
Else
GetTonerLevelFromElement = ""
End If
End Function
Private Function GetRegExpMatch(ByVal inputString As String, ByVal pattern As String) As Object
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.pattern = pattern
regex.Global = False
If regex.test(inputString) Then
Set GetRegExpMatch = regex.Execute(inputString)(0)
Else
Set GetRegExpMatch = Nothing
End If
End Function
Private Function GetHTMLContent(ByVal url As String) As String
Dim xhr As Object
Set xhr = CreateObject("MSXML2.XMLHTTP")
xhr.Open "GET", url, False
xhr.Send
If xhr.Status = 200 Then
GetHTMLContent = xhr.ResponseText
Else
GetHTMLContent = ""
End If
Set xhr = Nothing
End Function
If necessary i can provide the html code from one colour printer
Any ideas ?? Thanks in advance
I have a vba userform with all the printers of my company (mono or colour printers) , and now i'm triyng to get the toner level ( only to display the remaining toner in percentage ) without no success
I've tried several approaches , i created a button Get toner , when i click , the 4 textboxes (if printer is colour ) created don't get populate with the information
The code i have is this
Private Sub GetToner_Click()
' Get the IP address from TextBox2
Dim ipAddress As String
ipAddress = TextBox2.Value
' Get the HTML content from the printer's web page
Dim htmlContent As String
htmlContent = GetHTMLContent("http://" & ipAddress)
' Extract toner levels from the HTML content
Dim tonerLevels() As String
tonerLevels = ExtractTonerLevels(htmlContent)
' Update the TextBoxes with toner levels
TextBox5.Value = tonerLevels(0) ' Cyan Toner Level
TextBox6.Value = tonerLevels(1) ' Magenta Toner Level
TextBox7.Value = tonerLevels(2) ' Yellow Toner Level
TextBox8.Value = tonerLevels(3) ' Black Toner Level
End Sub
Private Function ExtractTonerLevels(ByVal html As String) As String()
Dim doc As Object
Set doc = CreateObject("HTMLFile")
doc.body.innerHTML = html
Dim tonerLevels(0 To 3) As String
' Cyan Toner Level
Dim cyanElements As Object
Set cyanElements = doc.getElementsByTagName("b")
Dim i As Integer
For i = 0 To cyanElements.Length - 1
If cyanElements(i).innerText = "Cartucho ciano" Then
Dim cyanLevel As String
cyanLevel = cyanElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(0) = Mid(cyanLevel, 1, Len(cyanLevel) - 1)
Exit For
End If
Next i
' Magenta Toner Level
Dim magentaElements As Object
Set magentaElements = doc.getElementsByTagName("b")
For i = 0 To magentaElements.Length - 1
If magentaElements(i).innerText = "Cartucho magenta" Then
Dim magentaLevel As String
magentaLevel = magentaElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(1) = Mid(magentaLevel, 1, Len(magentaLevel) - 1)
Exit For
End If
Next i
' Yellow Toner Level
Dim yellowElements As Object
Set yellowElements = doc.getElementsByTagName("b")
For i = 0 To yellowElements.Length - 1
If yellowElements(i).innerText = "Cartucho Amarelo" Then
Dim yellowLevel As String
yellowLevel = yellowElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(2) = Mid(yellowLevel, 1, Len(yellowLevel) - 1)
Exit For
End If
Next i
' Black Toner Level
Dim blackElements As Object
Set blackElements = doc.getElementsByTagName("b")
For i = 0 To blackElements.Length - 1
If blackElements(i).innerText = "Cartucho Preto" Then
Dim blackLevel As String
blackLevel = blackElements(i).ParentNode.NextSibling.getElementsByTagName("td")(0).getElementsByTagName("td")(0).Title
tonerLevels(3) = Mid(blackLevel, 1, Len(blackLevel) - 1)
Exit For
End If
Next i
ExtractTonerLevels = tonerLevels
End Function
Function FindElementByTagNameAndAttribute(doc As Object, tagName As String, attributeName As String, attributeValue As String) As Object
' Find the first element in the document that matches the specified tag name and attribute
Dim elements As Object
Set elements = doc.getElementsByTagName(tagName)
Dim element As Object
For Each element In elements
If element.getAttribute(attributeName) = attributeValue Then
Set FindElementByTagNameAndAttribute = element
Exit Function
End If
Next element
' Return Nothing if no matching element is found
Set FindElementByTagNameAndAttribute = Nothing
End Function
Private Function GetElementByInnerText(ByVal elements As Object, ByVal innerText As String) As Object
Dim i As Integer
For i = 0 To elements.Length - 1
If elements(i).innerText = innerText Then
Set GetElementByInnerText = elements(i)
Exit Function
End If
Next i
Set GetElementByInnerText = Nothing
End Function
Private Function GetTonerLevelFromElement(ByVal element As Object) As String
Dim tableElement As Object
Set tableElement = element.parentElement.parentElement.parentElement.getElementsByTagName("table")(1)
If Not tableElement Is Nothing Then
GetTonerLevelFromElement = Mid(tableElement.Rows(1).Cells(0).Title, 1, Len(tableElement.Rows(1).Cells(0).Title) - 1)
Else
GetTonerLevelFromElement = ""
End If
End Function
Private Function GetRegExpMatch(ByVal inputString As String, ByVal pattern As String) As Object
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.pattern = pattern
regex.Global = False
If regex.test(inputString) Then
Set GetRegExpMatch = regex.Execute(inputString)(0)
Else
Set GetRegExpMatch = Nothing
End If
End Function
Private Function GetHTMLContent(ByVal url As String) As String
Dim xhr As Object
Set xhr = CreateObject("MSXML2.XMLHTTP")
xhr.Open "GET", url, False
xhr.Send
If xhr.Status = 200 Then
GetHTMLContent = xhr.ResponseText
Else
GetHTMLContent = ""
End If
Set xhr = Nothing
End Function
If necessary i can provide the html code from one colour printer
Any ideas ?? Thanks in advance
