copy

Sunday, 19 August 2018

Last updated: 19/08/2018, 5 min read

How To Create & Use A Custom Function In Google Sheets


Introduction



Google Sheets, along with Google Docs and Google Slides are a spreadsheet, a word processor, and a presentation program respectively, all part of a free, web-based software office suite offered by Google within its Google Drive service. The three applications are available as web apps, mobile apps and desktop apps (on ChromeOS only). The applications are compatible with the corresponding Microsoft Office file formats, therefore, the user can save an “online file” to his desktop and then open it with the appropriate Office app.

To be more precise, the Google Sheets app is very similar to Excel. If you have ever used Excel, especially some pre-Ribbon version (Office 2003 and back), you will definitely understand how the Google Sheets app works. The similarities don’t stop only on the environment and the user interface. The Google Sheets app contains an internal script editor where the user can create his/her own custom functions, similar to VBA functions in Excel. The language that is used to create these custom functions in Google Sheets is called Apps Script. The Apps Script is also used in other Google apps, so it reminds a lot of the universal usage of VBA in the entire Office suite.

The Apps Script is actually the Google’s version of ECMAScript, which runs on its servers (not in the browser). Consequently, Apps Script can be considered as a browser-independent language. If you haven’t heard the ECMAScript in the past, don’t worry! You probably already know another “dialect” of it, called JavaScript. In short, Apps Script is based on JavaScript 1.6 with some portions of 1.7 and 1.8 and provides a subset of ECMAScript 5 API. According to Google, the Apps Script "provides easy ways to automate tasks across Google products and third party services”. This is the language that we will use in this tutorial.



Create a new spreadsheet on Google Sheets



Before we write our first custom function using Apps Script, we will learn first how to create a new blank spreadsheet on Google Sheets. So, please follow the next simple steps:

Step 1: First of all, ensure that you are logged in to your Google account.

Log In To Google Account

Step 2: Go to the Google Drive page.

Logged To Google Drive

Step 3: In this page, you should click on the New button. Then, on the drop-down menu select the Google Sheets option by clicking the small arrow. Finally, click on the Blank spreadsheet option.

Create A New Spreadsheet In Google Sheets

Step 4: A new spreadsheet is created and you are redirected to a new page. To rename and this spreadsheet, click on the Untitled spreadsheet title and enter your preferred name.

Rename The Spreadsheet

If you hit enter, the spreadsheet will look like the image below.

Renamed Spreadsheet

Note, that all the changes are automatically saved in Google Drive, so unlike Excel, you don’t have to manually save it. Here is what you will see on your Google Drive:

Renamed File On Google Drive



The Apps Script editor



Now that we have created and renamed our spreadsheet, we are ready to switch to our Apps Script editor. Select the Tools category from the menu and then click on the Script editor option.

Switch To Script Editor

A new page pop-up; that’s our Apps Script editor or if you prefer our Integrated Development Environment (IDE). Unlike the VBA IDE, it is relatively simpler, nevertheless, it includes sufficient functionality.

The Script Editor

The default project contains a single script file (Code.gs) and an empty function (myFunction), which we will modify in a little bit. Script files are similar to VBA modules. Multiple script files can be created and organized inside a single project (i.e. as it is in the case of a VB 6.0 project). Within each script file, you can write code that is accessible from all the script files included in the project. Unlike VBA, there is no option to restrict access using the Option Private Module.

If you need to rename the Untitled project, simply click on the title. An input box will pop-up, prompting you to give a name. Type your preferred name and click the OK button.

Rename The Project
Here is how the renamed project would look like.

The Renamed Apps Script Project



Creating your first Apps Script function



In this point, it should be highlighted that the custom function will be created inside a container-bound script that is part of our spreadsheet. The container-bound functions are equivalent to VBA functions that are part of an Excel spreadsheet. Bear in mind, though, that there are also standalone scripts, which are created on Google Drive and usually contain generic functionality that can be used across multiple Google apps. In other words, these scripts are not bound to a specific spreadsheet or document. However, we will talk about this kind of functions and scripts in a different tutorial.

Our first function will calculate the area of a circle, given its radius. The formula is very simple:
Area = (π ∙ Radius²) / 4

Here is the complete code for the custom function:

/**
 * This function returns the area of a circle given its radius. 
 *
 * @param {A1} radius A cell that contains the circle radius.
 * @return The area of the circle given its radius.
 * @customfunction
 */
function circleArea(radius) {
  return Math.PI * Math.pow(radius, 2) / 4;
} 

Let’s analyze the code a little bit:
  • The circleArea is the name of the function that will be used from the spreadsheet. Here we followed the typical camel case notation (e.g. the practice of writing compound words or phrases such that each word or abbreviation in the middle of the phrase begins with a capital letter, with no intervening spaces or punctuation).
  • The radius is our input variable. Note that, unlike VBA, we don’t have to declare the variable’s type (e.g. double) since, in Apps Script, all the variables are of type var.
  • The code that starts with the return word is actually the mathematical formula translated into code. Ιn Apps Script, similar to JavaScript, we have to use an internal library called Math for some common mathematical expressions (as it in the case of power and the constant pi - π).
  • Finally, the comments that are enclosed between “/*” and “*/” are optional, but very helpful since will be used by the Autocomplete feature, which we will see below.
Your first custom function is almost ready! As you can see in the image below, an asterisk appears next to the Code.gs file. Click the Save button or use the CTRL + S shortcut from your keyboard.

Custom Function Before Saving

Congratulations! You just created your first custom Apps Script function. Here is how the saved function would look like. The asterisk is gone and the function name will appear in the dropdown menu that contains the functions.

Custom Function Saved



Use the custom Apps Script function from the spreadsheet



You can now close the Apps Script editor and go back to the spreadsheet. In a random cell (e.g. B1) start typing the function name (=circleArea). If you just type =ci notice that the Autocomplete feature appears, showing the function description.

Typing The Function Name

If you click with the mouse upon the Autocomplete window, or simply press the Tab key, you will see the full function description. This is the reason why it is a good practice to fill the function description in the script editor.

Full Function Description

If you type =circleArea(5) and click the Enter, you will see a Loading message and after a few seconds, the actual result in the cell (19.63495408).

Custom Function With Value

Of course, apart from manual values, we can use the function with cell references. In the example below, we use the function with the cell A4.

Custom Function With Cell Reference

Well done! You have successfully created and used your first custom Apps Script function. More tutorials on Apps Script will follow soon. Meanwhile, if you need more information about the custom Apps Script functions, you can visit the official page.

Sunday, 15 July 2018

Last updated: 15/07/2018, 2 min read (without the code)

Get & Set The Default Windows Printer With VBA


Introduction



Although VBA is a great language for building Office “applications”, when it comes to handling Windows devices, such as a printer, for example, things start to become difficult. The obvious reason is that the VBA was not designed for this kind of purposes. However, what if your VBA “application” needs to know how many printers are installed and available in the particular computer? What if your “application” must set the default Windows printer to “Adobe PDF”, hence, printing in a PDF file, instead of a paper?

To answer the last two questions, somebody might think to search for some old Visual Basic 6.0 code snippets. In other words, he/she might try to find solutions based on some old example. While this totally OK, the VB 6.0 solutions will probably rely on one or more Windows APIs. So, if you are not very familiar using Windows APIs in your VBA code, you might have troubles adjusting the API calls. The latter is particularly true when the Office version in which your “application” will run, is 64bit. In that case, you need to carefully "alter" the API calls so as to work in 64bit (e.g. data type conversion: the Long should become LongPtr in 64bit).

But, are there any simpler solutions? Yes, there are! If we combine the VBA with Windows Management Instrumentation (WMI) and Windows Script Host (WSH) objects we can do wonders quite easily! The VBA module that follows demonstrates several techniques that show: how somebody can get the installed printers from a computer, how to check if a printer is the default one, and, finally, how to set a particular printer to be the default one.

Note: the term “application” in the above paragraphs actually implies a solution to a given problem (e.g. a budget spreadsheet), not an application with the strict definition of the term (e.g. an executable). You can develop “real” applications using VB 6.0, as well as with other programming languages, but not with VBA.



VBA code



The code below is an entire module that contains 3 VBA functions:
  • PrinterExists: A function that checks if there is a printer installed with the given name.
  • IsDefaultPrinter: A function that checks if the given printer corresponds to the default Windows printer.
  • SetDefaultPrinter: A functions that set the given printer to be the default Windows printer.
   
Next, there are 2 macros that demonstrate how these 3 functions can be used/combined to do something useful:
  • GetInstalledPrinters: A macro that loops through all the installed printers of the computer and writes their names in the "Printers" worksheet. Moreover, it checks if each printer is the default one or not.
  • SetAsTheDefaultPrinter: A macro that sets the selected range, if it corresponds to an installed printer, to be the default Windows printer. The user must select a range within the given range of (valid) printers, and, then, run the macro.

Option Explicit
        
    '-------------------------------------------------------------------------------------------------------------------------
    'This module contains 3 functions that can help you whenever you deal with printers from VBA:
    '- PrinterExists:           Checks if there is a printer installed with the given name.
    '- IsDefaultPrinter:        Checks if the given printer corresponds to the default windows printer.
    '- SetDefaultPrinter:       Makes the given printer to be the default one.
    '
    'After these functions, there are 2 macros that demonstrate how these functions can be used to do something useful.
    'Note that the macros were adjusted to work with the specific workbook that contains the worksheet named "Printers".
    '- GetInstalledPrinters:    Loops through all the installed printers and writes their names in the "Printers" worksheet.
    '                           Moreover, it checks if each printer is the default one.
    '
    '- SetAsTheDefaultPrinter:  The user selects a range within the given range of printers and then by running the macro
    '                           the selected printer becomes the default one.
    '
    'Written By:    Christos Samaras
    'Date:          14/08/2018
    'E-mail:        xristos.samaras@gmail.com
    'Site:          https://www.myengineeringworld.net
    '-------------------------------------------------------------------------------------------------------------------------
    
Function PrinterExists(printerName As String) As Boolean
    
    'Declaring the necessary variables.
    Dim computer            As String
    Dim wmiService          As Object
    Dim installedPrinters   As Variant
    Dim printer             As Object
    
    On Error Resume Next
    
    'Check if the printer name is empty.
    If printerName = vbNullString Then Exit Function

    'Set the computer. Dot means the computer running the code.    
    computer = "."
    
    'Get the WMI object
    Set wmiService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2")
    
    'Retrieve information about the installed printers (by running a query).
    Set installedPrinters = wmiService.ExecQuery("Select * from Win32_Printer")
        
    'If an error occurs in the previous step, the function should exit and return False.
    If Err.Number <> 0 Then Exit Function

    'Loop through all the installed printers. If the given name matches to any of the installed printers, exit the loop and return True.                      
    For Each printer In installedPrinters
        If UCase(printer.Name) = UCase(printerName) Then
            PrinterExists = True
            Exit Function
        End If
    Next printer
    
    On Error GoTo 0
    
End Function

Function IsDefaultPrinter(printerName As String) As Boolean
      
    'Declaring the necessary variables.
    Dim computer            As String
    Dim wmiService          As Object
    Dim installedPrinters   As Variant
    Dim printer             As Object
    
    On Error Resume Next
    
    'Check if the printer name is empty.
    If printerName = vbNullString Then Exit Function
    
    'Set the computer. Dot means the computer running the code.    
    computer = "."
    
    'Get the WMI object
    Set wmiService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2")
    
    'Retrieve information about the installed printers (by running a query).
    Set installedPrinters = wmiService.ExecQuery("Select * from Win32_Printer")
        
    'If an error occurs in the previous step, the function should exit and return False.
    If Err.Number <> 0 Then Exit Function

    'Loop through all the installed printers. If the given name matches to any of the installed printers                
    'and the Default property is set to True, exit the loop and return True.
    For Each printer In installedPrinters
        If UCase(printer.Name) = UCase(printerName) And printer.Default = True Then
            IsDefaultPrinter = True
            Exit Function
        End If
    Next printer
    
    On Error GoTo 0
    
End Function

Function SetDefaultPrinter(printerName As String) As Boolean
    
    'Declaring the necessary variable.
    Dim wshNetwork As Object
    
    On Error Resume Next
    
    'Check if the printer name is empty.
    If printerName = vbNullString Then Exit Function

    'Test if the printer is already the default one. If yes, return True.    
    If IsDefaultPrinter(printerName) = True Then
        SetDefaultPrinter = True
        Exit Function
    End If
        
    'The printer is not the default one. Create the WScript.Network object.
    Set wshNetwork = CreateObject("WScript.Network")
    
    'If the WScript.Network object was not created, exit.
    If wshNetwork Is Nothing Then Exit Function

    'Set the given printer to be the default one.    
    wshNetwork.SetDefaultPrinter printerName
                
    'Release the WScript.Network object.
    Set wshNetwork = Nothing
    
    'Check (again) if after the change, the given printer is indeed the default one.
    SetDefaultPrinter = IsDefaultPrinter(printerName)
    
    On Error GoTo 0
    
End Function

Sub GetInstalledPrinters()
      
    'Declaring the necessary variables.
    Dim sht                 As Worksheet
    Dim computer            As String
    Dim wmiService          As Object
    Dim installedPrinters   As Variant
    Dim printer             As Object
    Dim i                   As Integer
    
    On Error Resume Next
    
    'Set the worksheet in which the information will be written.
    Set sht = ThisWorkbook.Worksheets("Printers")
    
    'Check if the sheet exist (there is no error).
    If Err.Number <> 0 Then
        MsgBox "The sheet does not exists!", vbCritical, "Sheet Name Error"
        Exit Sub
    End If
    
    'Clear existing data.
    Call ClearAll
    
    'Set the computer. Dot means the computer running the code.    
    computer = "."
    
    'Get the WMI object
    Set wmiService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2")
    
    'Retrieve information about the installed printers (by running a query).
    Set installedPrinters = wmiService.ExecQuery("Select * from Win32_Printer")
        
    'If an error occurs in the previous step, inform the user.
    If Err.Number <> 0 Then
        MsgBox "Could not retrieve the printer information from WMI object!", vbCritical, "WMI Object Error"
        Exit Sub
    End If
              
    'Set the starting row.
    i = 5
     
    'Loop through all the installed printers and get their name. Check if one of them is the default one.
    For Each printer In installedPrinters
        
        'Write the results to the worksheet.
        sht.Range("C" & i).Value = printer.Name
        sht.Range("D" & i).Value = printer.Default
        i = i + 1
        
    Next printer
    
    On Error GoTo 0

End Sub

Sub SetAsTheDefaultPrinter()
    
    'Declaring the necessary variable.
    Dim sht     As Worksheet
    Dim rng     As Range
    
    On Error Resume Next
    
    'Set the worksheet in which the information will be written.
    Set sht = ThisWorkbook.Worksheets("Printers")
    
    'Check if the sheet exist (there is no error).
    If Err.Number <> 0 Then
        MsgBox "The sheet does not exists!", vbCritical, "Sheet Name Error"
        Exit Sub
    End If
    
    'Get the intersected range.
    Set rng = Application.Intersect(sht.Range("C5:C24"), Selection.Range("A1"))
    
    'If there is no "common" range, exit.
    If rng Is Nothing Then
        MsgBox "The selected range is outside the 'C5:C24' range!", vbCritical, "Invalid Common Range Error"
        Exit Sub
    End If
    
    'If the common range is empty, exit.
    If IsEmpty(rng) Then
        MsgBox "The range you selected is empty!", vbCritical, "Empty Range Error"
        Exit Sub
    End If
    
    'Check if the selected printer is already the default printer.
    If IsDefaultPrinter(rng.Range("A1")) Then
        MsgBox "The selected printer '" & rng.Range("A1") & "' is already the default printer!", vbExclamation, "Default Printer Warning"
        Exit Sub
    End If
    
    'Finally, set the selected printer as the default one and inform the user.
    If SetDefaultPrinter(rng.Range("A1")) = True Then
        
        'Run the GetInstalledPrinters macro to "prove" the change.
        Call GetInstalledPrinters
        
        'The process succeded.
        MsgBox "The selected printer '" & rng.Range("A1") & "' was set as the default printer!", vbInformation, "Success"
        
    Else
    
        'The process failed.
        MsgBox "It was impossible to set the selected printer '" & rng.Range("A1") & "' as the default printer!", vbCritical, "Failure"
        
    End If

End Sub

Sub ClearAll()
      
    'Declaring the necessary variable.
    Dim sht As Worksheet
    
    On Error Resume Next
    
    'Set the worksheet in which the information will be written.
    Set sht = ThisWorkbook.Worksheets("Printers")
    
    'Check if the sheet exist (there is no error).
    If Err.Number <> 0 Then
        MsgBox "The sheet does not exists!", vbCritical, "Sheet Name Error"
        Exit Sub
    End If
    
    'Clear the data.
    sht.Range("C5:D24").ClearContents
    
End Sub

Note that the two macros were adjusted to work with the specific workbook that contains a worksheet named "Printers". You can find this workbook in the Downloads section that follows.



Downloads



Download

The file can be opened with Excel 2007 or newer. Please enable macros before using it.

Saturday, 30 June 2018

Last updated: 03/07/2018, 1 min read (without the code)

Get Laptop Battery Information Through VBA


Introduction



As the title indicates, in this post we will learn how to get several properties related to the battery of the laptop that runs our VBA code. Unfortunately, VBA does not have any built-in functionality that can be used to retrieve this kind of information. Therefore, with the help of WMI we will get the following battery properties:
  • Availability
  • Battery status
  • Chemistry
  • Estimated charge remaining
  • Estimated run time
  • Time on battery
  • Time to full charge

These are probably the most useful ones. If you need other attributes, you can check this link to find the additional properties that are available in the Win32_Battery class. The technique to retrieve any of the other property is similar to the one used below.



VBA code



The code was written in a way that all the functions are based on the GetBatteryObject function, which returns an object containing several properties about the laptop's battery. The other functions simply use this object to check if a particular property exists. If yes, then they retrieve the value of that property. If the returned numeric value is an enumeration, as it is in the case of GetBatteryAvailability, GetBatteryStatus and GetBatteryChemistry functions, the code returns the actual string value. In the other cases, the functions return the numeric value that corresponds either to a charge percentage or to time (minutes/seconds).

Option Explicit

'-------------------------------------------------------------------------------------------
'This module contains some functions for retrieving information about the laptop's battery.
'The main function is the GetBatteryObject, which retrieves an object containing several
'properties about the laptop's battery. The other functions simply use this object to
'retrieve the appropriate property. The GetBatteryObject function uses WMI to query
'the Win32_Battery class of Windows. More information about this class can be found in:
'https://docs.microsoft.com/en-us/windows/desktop/cimwin32prov/win32-battery

'Written By:    Christos Samaras
'Date:          30/06/2018
'Last Updated:  03/07/2018
'E-mail:        xristos.samaras@gmail.com
'Site:          https://www.myengineeringworld.net
'-------------------------------------------------------------------------------------------

Private Function GetBatteryObject() As Object
    
    '----------------------------------------------------------------------------
    'Returns an object containing several properties about the laptop's battery.
    'The function is private, so as to not be visible from Excel worksheets.
    '----------------------------------------------------------------------------
    
    'Declaring the necessary variables.
    Dim computer    As String
    Dim wmiService  As Object
    Dim colItems    As Object
    Dim item        As Object
    
    On Error Resume Next
    
    'Set the computer.
    computer = "."
    
    'The root\cimv2 namespace is used to access the Win32_Battery class.
    Set wmiService = GetObject("winmgmts:\\" & computer & "\root\cimv2")
    
    'A select query is used to get a collection of battery objects.
    Set colItems = wmiService.ExecQuery("SELECT * FROM Win32_Battery", , 48)
    
    'Note, an alternative here will be to select only the properties you need and not all (the asterisk means all).
    'In that case, the query could be written like this:
    'Set colItems = wmiService.ExecQuery("SELECT Availability, BatteryStatus, Chemistry," + _
                                                "EstimatedChargeRemaining, EstimatedRunTime," + _
                                                "TimeOnBattery, TimeToFullCharge FROM Win32_Battery", , 48)
        
    'Get the first object that is not null.
    For Each item In colItems
        If Not IsNull(item) Then Set GetBatteryObject = item
        Exit Function
    Next
    
    'If no battery object is found, return nothing.
    Set GetBatteryObject = Nothing

    On Error GoTo 0
    
End Function

Public Function GetBatteryAvailability() As String
    
    '-----------------------------------------
    'Returns the availability of the battery.
    '-----------------------------------------
    
    'Declaring the necessary variables.
    Dim batteryObject   As Object
    Dim i               As Integer
            
    On Error Resume Next
    
    'Get the battery object.
    Set batteryObject = GetBatteryObject()
    If Not IsObject(batteryObject) Then
        GetBatteryAvailability = "Battery Object Error"
        Exit Function
    End If
    
    'Check if the Availability property can be retrieved.
    If IsNull(batteryObject.Availability) Then
        GetBatteryAvailability = "Battery Property Error"
        Exit Function
    End If
    
    'Get the numeric value from the property.
    i = CInt(batteryObject.Availability)
    If i < 1 Or i > 21 Then
        GetBatteryAvailability = "Battery Availability Error"
        Exit Function
    End If
    
    'Use the numeric value to return the actual string value.
    GetBatteryAvailability = Array("Other", "Unknown", "Running/Full Power", "Warning", "In Test", "Not Applicable", _
                                   "Power Off", "Off Line", "Off Duty", "Degraded", "Not Installed", "Install Error", _
                                   "Power Save - Unknown", "Power Save - Low Power Mode", "Power Save - Standby", _
                                   "Power Cycle", "Power Save - Warning", "Paused", "Not Ready", "Not Configured", _
                                   "Quiesced")(i - 1)
    
    'Release the battery object.
    Set batteryObject = Nothing
    
    On Error GoTo 0
    
End Function

Public Function GetBatteryStatus() As String
    
    '-----------------------------------
    'Returns the status of the battery.
    '-----------------------------------
    
    'Declaring the necessary variables.
    Dim batteryObject   As Object
    Dim i               As Integer
            
    On Error Resume Next
    
    'Get the battery object.
    Set batteryObject = GetBatteryObject()
    If Not IsObject(batteryObject) Then
        GetBatteryStatus = "Battery Object Error"
        Exit Function
    End If
    
    'Check if the BatteryStatus property can be retrieved.
    If IsNull(batteryObject.BatteryStatus) Then
        GetBatteryStatus = "Battery Property Error"
        Exit Function
    End If
    
    'Get the numeric value from the property.
    i = CInt(batteryObject.BatteryStatus)
    If i < 1 Or i > 11 Then
        GetBatteryStatus = "Battery Status Error"
        Exit Function
    End If
    
    'Use the numeric value to return the actual string value.
    GetBatteryStatus = Array("Discharging", "On A/C", "Fully Charged", "Low", "Critical", "Charging", "Charging High", _
                             "Charging Low", "Charging Critical", "Undefined", "Partially Charged")(i - 1)
    
    'Release the battery object.
    Set batteryObject = Nothing
    
    On Error GoTo 0

End Function

Public Function GetBatteryChemistry() As String
    
    '---------------------------------
    'Returns the battery's chemistry.
    '---------------------------------
    
    'Declaring the necessary variables.
    Dim batteryObject   As Object
    Dim i               As Integer
            
    On Error Resume Next
    
    'Get the battery object.
    Set batteryObject = GetBatteryObject()
    If Not IsObject(batteryObject) Then
        GetBatteryChemistry = "Battery Object Error"
        Exit Function
    End If
    
    'Check if the Chemistry property can be retrieved.
    If IsNull(batteryObject.Chemistry) Then
        GetBatteryChemistry = "Battery Property Error"
        Exit Function
    End If
    
    'Get the numeric value from the property.
    i = CInt(batteryObject.Chemistry)
    If i < 1 Or i > 11 Then
        GetBatteryChemistry = "Battery Chemistry Error"
        Exit Function
    End If
    
    'Use the numeric value to return the actual string value.
    GetBatteryChemistry = Array("Other", "Unknown", "Lead Acid", "Nickel Cadmium", "Nickel Metal Hydride", _
                                "Lithium-ion", "Zinc air", "Lithium Polymer")(i - 1)
    
    'Release the battery object.
    Set batteryObject = Nothing
    
    On Error GoTo 0
    
End Function

Public Function GetEstimatedChargeRemaining() As Integer
    
    '-------------------------------------------------------------
    'Returns the remaining charge of the battery as a percentage.
    'A value of 100 means that the battery is fully charged.
    '-------------------------------------------------------------
    
    'Declaring the necessary variable.
    Dim batteryObject   As Object
            
    On Error Resume Next
    
    'Get the battery object.
    Set batteryObject = GetBatteryObject()
    If Not IsObject(batteryObject) Then
        GetEstimatedChargeRemaining = "Battery Object Error"
        Exit Function
    End If
    
    'Check if the EstimatedChargeRemaining property can be retrieved.
    If IsNull(batteryObject.EstimatedChargeRemaining) Then
        GetEstimatedChargeRemaining = "Battery Property Error"
        Exit Function
    End If
    
    'Get the numeric value from the property.
    GetEstimatedChargeRemaining = CInt(batteryObject.EstimatedChargeRemaining)
    
    'Release the battery object.
    Set batteryObject = Nothing
    
    On Error GoTo 0
    
End Function

Public Function GetEstimatedRunTime() As Long
    
    '------------------------------------------------------------------------------------------------------------
    'Returns the time (in minutes) to battery charge depletion under the present load conditions if the utility
    'power is off, or lost and remains off, or the laptop is disconnected from a power source.
    'A value of 30 means that the battery can continue providing power to your laptop for about 30 minutes.
    '------------------------------------------------------------------------------------------------------------
    
    'Declaring the necessary variable.
    Dim batteryObject   As Object
            
    On Error Resume Next
    
    'Get the battery object.
    Set batteryObject = GetBatteryObject()
    If Not IsObject(batteryObject) Then
        GetEstimatedRunTime = "Battery Object Error"
        Exit Function
    End If
        
    'Check if the EstimatedRunTime property can be retrieved.
    If IsNull(batteryObject.EstimatedRunTime) Then
        GetEstimatedRunTime = "Battery Property Error"
        Exit Function
    End If
    
    'Get the numeric value from the property.
    GetEstimatedRunTime = CLng(batteryObject.EstimatedRunTime)
    
    'Release the battery object.
    Set batteryObject = Nothing
    
    On Error GoTo 0
    
End Function

Public Function GetTimeOnBattery() As Long
        
    '------------------------------------------------------------------------------------------------------------------
    'Returns the elapsed time (in seconds) since the computer system's UPS last switched to battery power or the time
    'since the system or UPS was last restarted, whichever is less. If the battery is "online", 0 (zero) is returned.
    '------------------------------------------------------------------------------------------------------------------
    
    'Declaring the necessary variable.
    Dim batteryObject   As Object
            
    On Error Resume Next
    
    'Get the battery object.
    Set batteryObject = GetBatteryObject()
    If Not IsObject(batteryObject) Then
        GetTimeOnBattery = "Battery Object Error"
        Exit Function
    End If
    
    'Check if the TimeOnBattery property can be retrieved.
    If IsNull(batteryObject.TimeOnBattery) Then
        GetTimeOnBattery = "Battery Property Error"
        Exit Function
    End If
    
    'Get the numeric value from the property.
    GetTimeOnBattery = CLng(batteryObject.TimeOnBattery)
    
    'Release the battery object.
    Set batteryObject = Nothing
    
    On Error GoTo 0
    
End Function

Public Function GetTimeToFullCharge() As Long
    
    '-------------------------------------------------------------------------------------------------------------
    'Returns the remaining time (in minutes) to charge the battery fully at the current charging rate and usage.
    'A value of 45 means that the battery will be fully charged in about 45 minutes.
    '-------------------------------------------------------------------------------------------------------------
    
    'Declaring the necessary variable.
    Dim batteryObject   As Object
            
    On Error Resume Next
    
    'Get the battery object.
    Set batteryObject = GetBatteryObject()
    If Not IsObject(batteryObject) Then
        GetTimeToFullCharge = "Battery Object Error"
        Exit Function
    End If
    
    'Check if the TimeToFullCharge property can be retrieved.
    If IsNull(batteryObject.TimeToFullCharge) Then
        GetTimeToFullCharge = "Battery Property Error"
        Exit Function
    End If
    
    'Get the numeric value from the property.
    GetTimeToFullCharge = CLng(batteryObject.TimeToFullCharge)
    
    'Release the battery object.
    Set batteryObject = Nothing
    
    On Error GoTo 0
    
End Function

The above code is contained in the sample workbook that you will find in the Downloads section that follows. As a bonus tip, you will also find there a "battery chart" that shows the remaining charge of your laptop's battery.



Downloads



Download

The file can be opened with Excel 2007 or newer. Please enable macros before using it.

Sunday, 20 May 2018

Last updated: 20/05/2018, 1 min read

Get External Hyperlinks From A Webpage


Introduction



Some years ago, I published a VBA code that proved to be very popular in blog users: the code and the accompanying workbook could be used for downloading files from the internet. One common request that I get since I published that code, is how to retrieve the hyperlinks from a web page, so as to download the files afterwards.

I decided to help all these blog users by creating a workbook that does exactly what they requested. So, the workbook that you will find in the downloads section can be used for grabbing all the hyperlinks from a given URL. The procedure is quite straightforward: just enter the URL on a specific cell and hit the Get Links button. After a few seconds (depending on your internet speed) you will have all the external hyperlinks from the particular URL. Moreover, apart from the hyperlinks, you will also get the displayed text for each hyperlink. In this way, you can match the hyperlink with its position on the web page and filter out those links that are not relevant.

NOTE: the code ignores internal hyperlinks and anchor tags. In other words, the hyperlinks that are retrieved should all start with "http".



Demonstration video



The short video below demonstrates the usage of the spreadsheet using as an example the URL of this blog. In the particular case, 43 hyperlinks retrieved.




Downloads



Download

The file can be opened with Excel 2007 or newer. Please enable macros before using it. The VBA code was protected using the Unviewable+.



Read also



Excel & VBA: Download Internet Files Automatically

Monday, 30 April 2018

Last updated: 03/05/2018, 2 min read (without the code)

Open A Password-Protected PDF File With VBA


Introduction



In the past, we have seen two ways to open PDF files with VBA: the first one involved the usage of the Adobe Object Model and it could be only used with Adobe Professional. The second one was more generic; it was taking advantage of the Windows API functions and it could be used by both Adobe Reader and Professional. Both ways worked and continue to work just fine. There is a problem, though: what will happen if the PDF file you want to open is password-protected? Is there a way to fill the password in the open dialog and continue opening the file?

The answer is, yes! The suggested solution relies on several Windows APIs since the Adobe Object Model does not provide an option/method for including the password when opening a PDF file. Note: the VBA code that you will see below is NOT a password cracking piece of code! The code implies that you know the password of the file. It just automates the opening procedure, especially if you have to open multiple PDF files.


Spy++ For Opening Locked PDF File


Main idea



The main idea behind the code below can be divided into four steps:
  1. First of all, the code checks if the given path is valid (e.g. the file exists). Then, the ShellExecute API is used to open the file using the associated default program (either Adobe Reader or Adobe Professional).
  2. The FindWindow API function is used to find the pop-up window that prompts the user to fill the password.
  3. By using the FindWindowEx API function, the code searches the subsequent child windows until the text box is reached (using the class RICHEDIT50W).
  4. Finally, the SendMessage and PostMessage API functions are invoked in order to fill the known password and hit the Open button.
Similar to many previous posts, the Spy++ software was used to specify the windows hierarchy when opening the password-protected file. The above image shows the window tree that should be navigated in order to find the text box that will receive the password.



VBA code



Below you will find the OpenLockedPdf macro that does the main work, the FileExists function that is responsible for testing the file existence, as well as the SamplePdfTest macro that performs a sample test. Note that:
  • The OpenLockedPdf macro can be used to open a PDF file that is NOT password-protected. In that case, the code that is right after the line of ShellExecute is ignored.
  • The macro can be used in every Office application, as well as in AutoCAD. It works with both 32 and 64-bit applications.

Option Explicit

'Declaring the necessary API functions for both 64 and 32 bit applications.
#If VBA7 And Win64 Then
    
    'For 64 bit applications.
    'Performs an operation on a specified file.
    Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                                        (ByVal hwnd As LongPtr, _
                                                        ByVal lpOperation As String, _
                                                        ByVal lpFile As String, _
                                                        ByVal lpParameters As String, _
                                                        ByVal lpDirectory As String, _
                                                        ByVal nShowCmd As Long) As LongPtr
    
    'Retrieves a handle to the top-level window whose class name and window name match the specified strings.
    'This function does not search child windows. This function does not perform a case-sensitive search.
    Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
                                                        (ByVal lpClassName As String, _
                                                        ByVal lpWindowName As String) As LongPtr
            
    'Retrieves a handle to a window whose class name and window name match the specified strings.
    'The function searches child windows, beginning with the one following the specified child window.
    'This function does not perform a case-sensitive search.
    Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                                        (ByVal hWnd1 As LongPtr, _
                                                        ByVal hWnd2 As LongPtr, _
                                                        ByVal lpClassName As String, _
                                                        ByVal lpWindowName As String) As LongPtr
       
    'Sends the specified message to a window or windows. The SendMessage function calls the window procedure
    'for the specified window and does not parentWindowurn until the window procedure has processed the message.
    Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
                                                        (ByVal hwnd As LongPtr, _
                                                        ByVal wMsg As Long, _
                                                        ByVal wParam As LongPtr, _
                                                        lParam As Any) As LongPtr
        
    'Places (posts) a message in the message queue associated with the thread that created the specified
    'window and parentWindowurns without waiting for the thread to process the message.
    Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
                                                        (ByVal hwnd As LongPtr, _
                                                        ByVal wMsg As Long, _
                                                        ByVal wParam As LongPtr, _
                                                        ByVal lParam As LongPtr) As Long
                                                    
                                                                                                                        
#Else

    'For 32 bit applications.
    Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                                        (ByVal hwnd As Long, _
                                                        ByVal lpOperation As String, _
                                                        ByVal lpFile As String, _
                                                        ByVal lpParameters As String, _
                                                        ByVal lpDirectory As String, _
                                                        ByVal nShowCmd As Long) As Long
                                                        
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                                                        (ByVal lpClassName As String, _
                                                        ByVal lpWindowName As String) As Long

    Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                                        (ByVal hWnd1 As Long, _
                                                        ByVal hWnd2 As Long, _
                                                        ByVal lpClassName As String, _
                                                        ByVal lpWindowName As String) As Long

    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                                        (ByVal hwnd As Long, _
                                                        ByVal wMsg As Long, _
                                                        ByVal wParam As Long, _
                                                        lParam As Any) As Long

    Public Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" _
                                                        (ByVal hwnd As Long, _
                                                        ByVal wMsg As Long, _
                                                        ByVal wParam As Long, _
                                                        ByVal lParam As Long) As Long
                                                        
#End If

'Constants used in API functions.
Public Const SW_HIDE As Long = 0
Public Const SW_SHOWNORMAL As Long = 1
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWMINIMIZED As Long = 2
Public Const WM_SETTEXT = &HC
Public Const VK_RETURN = &HD
Public Const WM_KEYDOWN = &H100

Public Sub OpenLockedPdf(pdfPath As String, password As String)
    
    '------------------------------------------------------------------------
    'Opens a password-protected PDF file, given its (known) password.
    'API functions are used to find the pop-up window and fill the password.
    '
    'The subroutine can be used in every Office application, as well as
    'in AutoCAD. It works for both 32 and 64 bit applications.
    
    'The macro also works with PDF files that are NOT password-protected.
    'In that case, the code after the line of ShellExecute is ignored.
    
    'Written By:    Christos Samaras
    'Date:          30/04/2018
    'E-mail:        xristos.samaras@gmail.com
    'Site:          http://www.myengineeringworld.net
    '------------------------------------------------------------------------
           
    'Declaring the necessary variables (different for 32 or 64 bit applications).
    #If VBA7 And Win64 Then
        Dim parentWindow            As LongPtr
        Dim firstChildWindow        As LongPtr
        Dim secondChildFirstWindow  As LongPtr
    #Else
        Dim parentWindow            As Long
        Dim firstChildWindow        As Long
        Dim secondChildFirstWindow  As Long
    #End If
    Dim timeCount                   As Date

    'Check if the PDF file exists.
    If FileExists(pdfPath) = False Then
        MsgBox "The PDF file doesn't exist!", vbCritical, "Error in PDF path"
        Exit Sub
    End If
        
    'The ShellExecute API will try to open the PDF file using the default application that
    'is associated with PDF files (either Adobe Reader or Professional).
    ShellExecute Application.hwnd, "Open", pdfPath, vbNullString, "C:\", SW_SHOWNORMAL
             
    'Note: The code below will be ignored if the PDF file has no protection.
    
    'Find the handle of the pop-up window.
    timeCount = Now()
    Do Until Now() > timeCount + TimeValue("00:00:05")
        parentWindow = 0
        DoEvents
        parentWindow = FindWindow("#32770", "Password")
        If parentWindow <> 0 Then Exit Do
    Loop
    
    If parentWindow <> 0 Then
    
        'Find the handle of the first child window (it is a group box).
        timeCount = Now()
        Do Until Now() > timeCount + TimeValue("00:00:05")
            firstChildWindow = 0
            DoEvents
            firstChildWindow = FindWindowEx(parentWindow, ByVal 0&, "GroupBox", vbNullString)
            If firstChildWindow <> 0 Then Exit Do
        Loop

        'Find the handle of the subsequent child window (it is the text box for filling the password).
        If firstChildWindow <> 0 Then
            timeCount = Now()
            Do Until Now() > timeCount + TimeValue("00:00:05")
                secondChildFirstWindow = 0
                DoEvents
                secondChildFirstWindow = FindWindowEx(firstChildWindow, ByVal 0&, "RICHEDIT50W", vbNullString)
                If secondChildFirstWindow <> 0 Then Exit Do
            Loop
            
            'The handle was found, so...
            If secondChildFirstWindow <> 0 Then
            
                'Fill the password in the text box.
                SendMessage secondChildFirstWindow, WM_SETTEXT, 0&, ByVal password
                
                'Press the OK button (it is the default action, so no need to find the handle of the button).
                PostMessage secondChildFirstWindow, WM_KEYDOWN, VK_RETURN, 0

            End If
        
        End If
        
    End If
   
End Sub

Function FileExists(FilePath As String) As Boolean
   
    '--------------------------------------------------
    'Checks if a file exists (using the Dir function).
    '--------------------------------------------------

    On Error Resume Next
    If Len(FilePath) > 0 Then
        If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
    End If
    On Error GoTo 0
   
End Function

Sub SamplePdfTest()
    
    'Full path example that can be used in every Office application, as well as with AutoCAD:
    'OpenLockedPdf "C:\Users\Christos\Desktop\Locked File.pdf", "Newsletter"
    
    'Relative path example (in Excel):
    'OpenLockedPdf ThisWorkbook.Path & "\" & "Locked File.pdf", "Newsletter"
    
    'For this example only (with the button):
    OpenLockedPdf ThisWorkbook.Sheets("Open Locked Sample File").Range("C3"), ThisWorkbook.Sheets("Open Locked Sample File").Range("C5")
    
End Sub



Demonstration video



The video that follows demonstrates the result of the "OpenLockedPdf" macro, as well  as gives more information on the usage of Spy++.




Downloads



Download

The zip file contains a sample PDF file that is locked with a password, as well as a sample workbook containing the code presented above that can be used to open that file (the password is included). The workbook can be opened with Excel 2007 or newer. Please enable macros before using it. Finally, there is also a VBA module with the code to attach it in any Office or AutoCAD application you might have.



Read also



VBA Macro To Open A PDF File
Open PDF File With VBA