Windows Battery Report Batch/Macro

Associate
Joined
20 Nov 2016
Posts
764
Not sure if this is any good, but was a bit tired of totting up the 'Active' hours on my Surface Pro top understand the total active hours of use, as whilst the report is good, it does not give total hours since recharge.

First thing is to create a batch file or .BAT file via notepad, I pinched from some code online and tweaked slightly

powercfg /batteryreport
start %CD%/battery-report.html
"C:\Program Files\Microsoft Office 15\root\office15\EXCEL.EXE" "C:\Users\lmg80\Desktop\Battery Macro.xlsm"

This then opens Excel, and subtotals the 'Active' 'Duration' as itemised under the 'Battery usage' of the report - only thing is it records last three days and need to sort this when I have more that one day logged on the report

The macro will then show a msgbox with the active time, post clicking okay Excel is closed - saves like 1 or 2 minutes lol but had an hour to kill and was fed up adding it up manually.

If you find it useful, please feel free to use. I will update once I have more than one day, so it will only report total time since the battery was last charged to 100%

Dim r As Integer, c As Integer, i As Integer
Dim ws As Worksheet
Dim wb As Workbook, wb2 As Workbook
Dim stime As String, stimef As String

Sub auto_open()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set ws = Sheets("battery")
Set wb = ActiveWorkbook

wb.Activate
Set wb2 = Workbooks.Open("C:\Users\lmg80\Desktop\Battery-report.html")
wb2.Worksheets("battery-report").Cells.Copy
wb.Activate
ws.Range("A1").PasteSpecial xlPasteValues
wb2.Close SaveChanges:=False

r = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To r
If ws.Range("A" & i).Value = "Battery usage" Then
c = i
Else
End If
Next
ws.Rows(1).Resize(c - 1).Delete xlUp
r = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To r
If ws.Range("A" & i).Value = "Usage history" Then
c = i
Else
End If
Next

ws.Rows(c).Resize(r).Delete xlUp
r = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 5 To r - 5
If i = r Then
GoTo finalformat
End If
If ws.Range("B" & i).Value <> "Active" Then
ws.Rows(i).Delete xlUp
i = i - 1
r = ws.Range("A" & Rows.Count).End(xlUp).Row
Else
End If
Next
finalformat:
r = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("C" & r + 1).Value = Application.Sum(Range("C5").Resize(r - 4, 1))
ws.Range("C" & r + 1).NumberFormat = "hh:mm:ss"
ws.Range("C" & r + 1).Font.Bold = True
stime = ws.Range("C" & r + 1).Value
stimef = Format(stime, "hh:mm:ss")

MsgBox ("Battery time has been " & stimef), vbInformation, "Surface Pro Time"
Application.Quit
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub
 
Back
Top Bottom