VBA to get toner from a selected printer on userform

malveiro

New Member
Joined
May 13, 2015
Messages
32
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
 
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: VBA to get toner level
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: VBA to get toner level
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
My apologies , i didn't know .
 
Upvote 0
Still no success , the max that made was no errors , but not populating the textboxes .
With the old models , no problem , i can get from everyone ( including color ) , but the recent ones , that's where the problem is

I know that the page is embedded web server page with Lexmark , i was wondering if the attributes were hidden , or the values were hidden , but , i think they not hidden , but i couldn't get them
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,215
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top