Showing posts with label Excel. Show all posts
Showing posts with label Excel. Show all posts

Wednesday, 21 July 2021

Use Python to write file tags from Excel VBA

This post was prompted by a bounty on a Stack Overflow question which details VBA code that can read file tags; questioner wants to know if VBA can write these tags as well. Sorry to say that I do not know of any current VBA referencable type libraries (there was once a DSOFiles.dll but not on my current machine). Instead we can leverage the comprehensive Python ecosystem and create a Python class callable from Excel VBA, below is a Python listing for the FilePropertiesSetter.py script.

The Python COM gateway class pattern is one I give dozens of times on this blog so I will skip details of that. The key magic is in the FilePropertiesSetter.changeSingleProperty() method which I give now without error handling ...

1 properties = propsys.SHGetPropertyStoreFromParsingName(self.filename, 
                            None, shellcon.GPS_READWRITE, propsys.IID_IPropertyStore)
2 propKey = propsys.PSGetPropertyKeyFromName(propName)
3 newValuesType = (pythoncom.VT_VECTOR | pythoncom.VT_BSTR) if isinstance(newValue,list) else pythoncom.VT_BSTR
4 propVariantNewValue = propsys.PROPVARIANTType(newValue, newValuesType)
5 properties.SetValue(propKey,propVariantNewValue)
6 properties.Commit()

So, essentially this code opens up the file's tag property store (line 1). On line 2 we find the property's key from the property's friendly name (e.g. "System.Category"). Line 3 determines if we're dealing we an array or not to help construct the new property. Line 4 constructs the new value in a form acceptable to that particular library. Line 5 actually makes the change. Line 6 commits the change and closes the file store.

The rest of the script is essentially helper methods.

The scripts has a number of libraries and so be prepared for some installation, some pip install commands. One pitfall I had to code for is when user passes in a two dimensional variant array such as if they had lifted values off a block of cells (I think the StackOverflow questioner was wanting this), the code to handle this is in FilePropertiesSetter.ensureList() which also split a comma separated string into an array (list).

FilePropertiesSetter.py needs to run once, and will request Administrator privileges to register the class with the COM registry.

FilePropertiesSetter.py

import os
import pythoncom
from win32com.propsys import propsys, pscon
from win32com.shell import shellcon
from win32com.server.exception import COMException
import winerror
import numpy

class FilePropertiesSetter(object):	
    _reg_clsid_ = "{5ED433A9-C5F9-477B-BF0A-C1643BBAE382}"
    _reg_progid_ = 'MyPythonProject3.FilePropertiesSetter'
    _public_methods_ = ['setFilename','setTitle','setKeywords','setCategory','setSubject','setComment']
	
    def __init__(self):
        pass

    def setFilename(self, filename: str):
        if not os.path.exists(filename):
            raise COMException(description="Specified file '" + filename + "' does not exist!  Subsequent calls will fail!", 
                    scode=winerror.E_FAIL, source = "FilePropertiesSetter")
        else:
            self.filename = filename

    def ensureList(self, arg):
        # despite hinting that one pass a string it seems Python will accept a VBA array as a tuple
        # so I need to convert tuples to a list, and split csv strings to a list
        # and flatten any 2d tables to a list

        try:
            if type(arg) is tuple:
                list2 = list(arg)
                
                if numpy.ndim(list2)>1:
                    # flatten any two dimension table to a one dimensional list
                    return [item for sublist in list2 for item in sublist]
                else:
                    return list2
            else:
                if isinstance(arg,list):    
                    return arg
                else:
                    return arg.split(",")

        except Exception as ex:
            raise COMException(description="error in ensureList for arg '" + str(arg)  + "'\n" + (getattr(ex, 'message', repr(ex))) ,
                    scode=winerror.E_FAIL, source = "FilePropertiesSetter")

    def setTitle(self, title: str):
    	# https://docs.microsoft.com/en-us/windows/win32/properties/props-system-title
    	self.changeSingleProperty( "System.Title", title)

    def setKeywords(self, keywords: str):

        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-keywords
        self.changeSingleProperty( "System.Keywords", self.ensureList(keywords))

    def setCategory(self, category: str):
        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-category
        self.changeSingleProperty( "System.Category", self.ensureList(category)  )

    def setSubject(self, subject: str):
        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-subject
        self.changeSingleProperty( "System.Subject", subject)

    def setComment(self, comment: str):
        # https://docs.microsoft.com/en-us/windows/win32/properties/props-system-comment
        self.changeSingleProperty( "System.Comment", comment)

    def changeSingleProperty(self,  propName: str, newValue):
        propKey = None 
        if hasattr(self,'filename') and self.filename is not None:      

                try:
                    properties = propsys.SHGetPropertyStoreFromParsingName(self.filename, 
                            None, shellcon.GPS_READWRITE, propsys.IID_IPropertyStore)
                except Exception as ex:
                    raise COMException(description="Could not open properties for file '" + self.filename + "'\n" + (getattr(ex, 'message', repr(ex))) ,
                            scode=winerror.E_FAIL, source = "FilePropertiesSetter")
            
                try:

                    propKey = propsys.PSGetPropertyKeyFromName(propName)
                except Exception as ex:
                    raise COMException(description="Could not find property key for property named '" + propName + "'\n" + (getattr(ex, 'message', repr(ex)))  , 
                            scode=winerror.E_FAIL, source = "FilePropertiesSetter")
                    
                if propKey is not None:
                    try: 
                        newValuesType = (pythoncom.VT_VECTOR | pythoncom.VT_BSTR) if isinstance(newValue,list) else pythoncom.VT_BSTR
                        propVariantNewValue = propsys.PROPVARIANTType(newValue, newValuesType)
                        properties.SetValue(propKey,propVariantNewValue)
                        properties.Commit()
                    except Exception as ex:
                        raise COMException(description="Error whilst setting value ...'\n" + (getattr(ex, 'message', repr(ex)))  , 
                                scode=winerror.E_FAIL, source = "FilePropertiesSetter")

def RegisterThis():
    print("Registering COM servers...")
    import win32com.server.register
    win32com.server.register.UseCommandLine(FilePropertiesSetter)

if __name__ == '__main__':
    RegisterThis()	
    pass

def Test():
    propsSetter=FilePropertiesSetter()
    propsSetter.setFilename(r"N:\FileProps\Newbook.xlsx") # use your own filename (obviously)
    propsSetter.setKeywords("python,keywords")
    propsSetter.setCategory("python,category")
    propsSetter.setTitle("python title")
    propsSetter.setSubject("python subject")
    propsSetter.setComment("python comment")

After FilePropertiesSetter.py is run once and correctly registered (don't forget you may need some installation) then it is scriptable from VBA with code like the following ...

Option Explicit

Sub TestPythonClass()

    Dim objPropsSetter As Object
    Set objPropsSetter = VBA.CreateObject("MyPythonProject3.FilePropertiesSetter")
    
    objPropsSetter.setFilename "N:\FileProps\Newbook.xlsx"
    objPropsSetter.setTitle "VBA Title"
    objPropsSetter.setSubject "VBA Subject"
    objPropsSetter.setComment "VBA Comment"
    objPropsSetter.setKeywords "Foo2,bar"
    'objPropsSetter.setKeywords Array("Foo1", "bar1")
    objPropsSetter.setCategory Sheet1.Range("A1:B2").Value2

End Sub

You will need to call setFilename because that is how the script knows which file to operate upon.

Enjoy!

Tuesday, 31 March 2020

Javascript - Binary representation of VBA's Variant Array

I am delighted to give a world first in this post where I give JavaScript code to convert a JavaScript array into a byte array loadable into a VBA variant array. This gives an efficient binary serialization format for web services and other network calls where the end client is VBA and especially Excel worksheet cells.

Following on from the previous post where I document an undocumented file serialization format used by VBA with the FreeFile, Open For Binary and Put statements. I can now go on to give some JavaScript to convert two dimensional JavaScript arrays containing JavaScript variables therein to a byte array directly loadable by VBA into a variant array.

This now means a VBA client need not consume Xml or JSON when calling a web service. This is a big win because both Xml and JSON are string based and require parsing into data structures which is expensive. The Xml needs further code to interrogate the nodes with XPath etc. If the end destination for the data is the worksheet then the variant array can be directly pasted into cells (some code is give below).

To get VBA client code to do less work requires the server-side code to do more work. A JavaScript module, JavaScriptToVBAVariantArray.js, is given below which converts JavaScript arrays and variables into a byte array directly loadable by VBA (save for an few initial bytes conveying number of rows and columns).

As well the key JavaScript module, JavaScriptToVBAVariantArray.js, I also give some Node.js server-side JavaScript code to implement a web service that demonstrates the byte array being communicated to a VBA client.

JavaScriptToVBAVariantArray.js - module common to browser and server

So the following JavaScript module is usable in both the browser client and a Node.js server. It encapsulates all the logic to convert a two dimensional (block not nested) JavaScript array containing primitives of strings, Booleans, dates and numbers to a byte array loadable by VBA into a Variant array ready to be pasted onto a worksheet. Also included is logic to take a JavaScript Error object and convert this to an Excel worksheet error code so one can transmit #REF!, #N/A! and #NAME? errors.

The code is implemented as a prototyped class, it includes two test methods JavaScriptToVBAVariantArray.testPersistVar and JavaScriptToVBAVariantArray.testPersistGrid to demonstrate the code's usage. The remaining methods contain production logic that utilize ArrayBuffers and collaborating classes Float64Array and Uint8Array.

So the following code to be saved to its own separate file called JavaScriptToVBAVariantArray.js which then should be added to a Node.js project. I am using Microsoft Visual Studio for a development environment.

'use strict';

// module exporting for node.js and browsers with thanks to
// https://www.matteoagosti.com/blog/2013/02/24/writing-javascript-modules-for-both-browser-and-node/

(function () {
    var JavaScriptToVBAVariantArray = (function () {
        var JavaScriptToVBAVariantArray = function (options) {
            var pass; //...
        };


        JavaScriptToVBAVariantArray.prototype.testPersistVar = function testPersistVar() {
            try {
                var payload;
                //payload = "Hello World";
                //payload = false;
                //payload = 655.35;
                payload = new Date(1989, 9, 16, 12, 0, 0);
                var payloadEncoded = persistVar(payload);
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.testPersistGrid = function testPersistGrid() {
            try {
                var rows = 2;
                var columns = 4;
                var arr = this.createGrid(rows, columns);
                arr[0][0] = "Hello World";
                arr[0][1] = true;
                arr[0][2] = false;
                arr[0][3] = null;

                arr[1][0] = 65535;
                arr[1][1] = 7.5;
                arr[1][2] = new Date(1989, 9, 16, 12, 0, 0);
                arr[1][3] = new Error(2042);

                var payloadEncoded = this.persistGrid(arr, rows, columns);
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistGrid = function persistGrid(grid, rows, columns) {
            try {

                var payloadEncoded = new Uint8Array(4);
                payloadEncoded[0] = rows % 256; payloadEncoded[1] = Math.floor(rows / 256);
                payloadEncoded[2] = columns % 256; payloadEncoded[3] = Math.floor(columns / 256);
                var elementBytes;
                for (var colIdx = 0; colIdx < columns; colIdx++) {
                    for (var rowIdx = 0; rowIdx < rows; rowIdx++) {
                        elementBytes = this.persistVar(grid[rowIdx][colIdx]);
                        var arr = [payloadEncoded, elementBytes];

                        payloadEncoded = this.concatArrays(arr); // Browser
                    }
                }
                return payloadEncoded;
            }
            catch (err) {
                console.log(err.message);
            }
        };


        JavaScriptToVBAVariantArray.prototype.concatArrays = function concatArrays(arrays) {
            // With thanks to https://javascript.info/arraybuffer-binary-arrays


            // sum of individual array lengths
            let totalLength = arrays.reduce((acc, value) => acc + value.length, 0);

            if (!arrays.length) return null;

            let result = new Uint8Array(totalLength);

            // for each array - copy it over result
            // next array is copied right after the previous one
            let length = 0;
            for (let array of arrays) {
                result.set(array, length);
                length += array.length;
            }

            return result;
        };

        JavaScriptToVBAVariantArray.prototype.createGrid = function createGrid(rows, columns) {
            try {
                return Array.from(Array(rows), () => new Array(columns));
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistVar = function persistVar(v) {
            try {

                if (v === null) {
                    // return a Null
                    var nullVt = new Uint8Array(2);
                    nullVt[0] = 1;
                    return nullVt;

                } else if (v instanceof Error) {

                    return this.persistError(v);

                } else if (typeof v === 'undefined') {
                    return new Uint8Array(2); // return an Empty

                } else if (typeof v === "boolean") {
                    // variable is a boolean
                    return this.persistBool(v);
                } else if (typeof v.getMonth === "function") {
                    // variable is a Date
                    return this.persistDate(v);
                } else if (typeof v === "string") {
                    // variable is a boolean
                    return this.persistString(v);
                } else if (typeof v === "number") {
                    // variable is a number
                    return this.persistNumber(v);
                }

            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistError = function persistError(v) {
            try {
                var errorVt = new Uint8Array(6); // return a vtError
                errorVt[0] = 10; errorVt[4] = 10; errorVt[5] = 128;

                var errorNumber;
                try {
                    errorNumber = parseInt(v.message);
                }
                catch (err) {
                    errorNumber = 2000;
                    console.log(err.message);
                }
                errorVt[2] = errorNumber % 256; errorVt[3] = Math.floor(errorNumber / 256);

                return errorVt;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistNumber = function persistNumber(v) {
            try {
                var bytes;
                if (Number.isInteger(v)) {
                    bytes = new Uint8Array(6);
                    bytes[0] = 3; bytes[1] = 0;  // VarType 5 = Long
                    bytes[2] = v % 256; v = Math.floor(v / 256);
                    bytes[3] = v % 256; v = Math.floor(v / 256);
                    bytes[4] = v % 256; v = Math.floor(v / 256);
                    bytes[5] = v % 256;

                } else {
                    bytes = this.persistDouble(v, 5);
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistDate = function persistDate(v) {
            try {
                // convert JavaScript 1970 base to VBA 1900 base
                // https://stackoverflow.com/questions/46200980/excel-convert-javascript-unix-timestamp-to-date/54153878#answer-54153878
                var xlDate = v / (1000 * 60 * 60 * 24) + 25569;
                return this.persistDouble(xlDate, 7);
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistDouble = function persistDouble(v, vt) {
            try {
                var bytes;
                bytes = new Uint8Array(10);
                bytes[0] = vt; bytes[1] = 0;  // VarType 5 = Double or 7 = Date
                var doubleAsBytes = this.doubleToByteArray(v);
                for (var idx = 0; idx < 8; idx++) {
                    bytes[2 + idx] = doubleAsBytes[idx];
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.doubleToByteArray = function doubleToByteArray(number) {
            try {
                // https://stackoverflow.com/questions/25942516/double-to-byte-array-conversion-in-javascript/25943197#answer-39515587
                var buffer = new ArrayBuffer(8);         // JS numbers are 8 bytes long, or 64 bits
                var longNum = new Float64Array(buffer);  // so equivalent to Float64

                longNum[0] = number;

                return Array.from(new Int8Array(buffer));
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistString = function persistString(v) {
            try {
                var strlen = v.length;
                var bytes = new Uint8Array(strlen + 4);
                bytes[0] = 8; bytes[1] = 0;  // VarType 8 = String
                bytes[2] = strlen % 256; bytes[3] = Math.floor(strlen / 256);
                for (var idx = 0; idx < strlen; idx++) {
                    bytes[idx + 4] = v.charCodeAt(idx);
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        JavaScriptToVBAVariantArray.prototype.persistBool = function persistBool(v) {
            try {
                var bytes = new Uint8Array(4);
                bytes[0] = 11; bytes[1] = 0;   // VarType 11 = Boolean
                if (v === true) {
                    bytes[2] = 255; bytes[3] = 255;
                } else {
                    bytes[2] = 0; bytes[3] = 0;
                }
                return bytes;
            }
            catch (err) {
                console.log(err.message);
            }
        };

        return JavaScriptToVBAVariantArray;
    })();

    if (typeof module !== 'undefined' && typeof module.exports !== 'undefined')
        module.exports = JavaScriptToVBAVariantArray;
    else
        window.JavaScriptToVBAVariantArray = JavaScriptToVBAVariantArray;
})();

Node.js server code

The following code should is for running in Node.js. Start with a new Blank Node.js Web Application project in Microsoft Visual Studio, add the JavaScriptToVBAVariantArray.js module listed above. In the server.js file replace the code with the listing below. Running the project should spawn a new browser and then print something like the following, i.e. a mix of printable and non-printable characters; this is a browser attempting to display the generated byte array.

    Hello World ÿÿ ÿÿ  @  «ªªª® à@  ú  €
'use strict';

{
    try {
        var JavaScriptToVBAVariantArray = require('./JavaScriptToVBAVariantArray');
        var v = new JavaScriptToVBAVariantArray();
        var payloadEncoded = v.testPersistGrid();
    }
    catch (err) {
        console.log('Could not find JavaScriptToVBAVariantArray.js module:' + err.message);
    }
}

require('http').createServer(function (req, res) {
    try {
        var q = require('url').parse(req.url, true);
        if (q.pathname === '/') {
            /* it's the request for our serialized Variant array */
            res.writeHead(200, { 'Content-Type': 'text/html' });

            // https://stackoverflow.com/questions/8609289/convert-a-binary-nodejs-buffer-to-javascript-arraybuffer
            var buffer = Buffer.from(new Uint8Array(payloadEncoded));
            res.end(buffer);
        }
        else {
            var filename = "." + q.pathname;
            var fs = require('fs');
            fs.readFile(filename, function (err, data) {
                if (err) {
                    res.writeHead(404, { 'Content-Type': 'text/html' });
                    return res.end("404 Not Found");
                }
                res.writeHead(200, { 'Content-Type': 'text/html' });
                res.write(data);
                return res.end();
            });
        }
    }
    catch (err) {
        console.log(err.message);
    }
}).listen(process.env.PORT || 1337);

HTMLPage.html (optional)

I intend the end client to be VBA as we are demonstrating how to serialize to a byte array loadable by VBA. Nevertheless, I include an HTML page to prove the JavaScript works in the browser. Also, if one follows the instructions on the web page and one opens the Dev Tools and the Console then one can see the byte array is a more readily viewable form (or at least more viewable that the non-printable characters above). Once this is added to your Node.js project then in a browser you can type the url http://localhost:1337/HtmlPage.html to access the page.

<!DOCTYPE html>

<html xmlns="http://www.w3.org/1999/xhtml">
<head>
    <meta charset="utf-8" />
    <title></title>
</head>
<body>
    <p>
        <span style="font-family:Courier New, Courier, monospace">
            Look in the console!
            Do this by right-click menu and then Inspect to get the DevTools window
            then click on the Console tab
        </span>
    </p>
    <script src="https://raw.githubusercontent.com/arextar/browser-buffer/master/browser-buffer.min.js"></script>
    <script src="JavaScriptToVBAVariantArray.js"></script>
    <script>
        var v = new JavaScriptToVBAVariantArray();
        var payloadEncoded = v.testPersistGrid();
        console.log(payloadEncoded);
    </script>
</body>
</html>

Client VBA Code

Finally, we get to the VBA client code. Paste this into a standard module, you will need some code from the previous post. You will also need a Tools->Reference to Microsoft WinHTTP Services, version 5.1 to make the HTTP call.

So the listing below will call into the Javascript web service given above, it takes the HTTP response and then reads the rows and columns from the first four bytes, the remaining bytes it will write to a temporary file (this could be speeded with the use of a RAM disk). The temporary file is then read directly into a variant array new dimensioned with the correct rows and columns.

At this point any VBA code can work with this variant array like it was any other as the byte array has been converted to a VBA native data structure! The code below goes on to paste the variant array to a block of cells on a worksheet (please save your work as this overwrites the cells).

In the pasted cells (screenshot given) we can see a string, two booleans, a deliberately empty cell, an integer, a decimal number, a date, and a #N/A worksheet error code. This demonstrates the full range of variable types that can be transmitted via the byte array.

Sub TestByWinHTTP()
    Dim WinHttp As WinHttp.WinHttpRequest '* Tools->References->Microsoft WinHTTP Services, version 5.1
    Set WinHttp = New WinHttp.WinHttpRequest
    WinHttp.Open "GET", "http://localhost:1337/", False
    WinHttp.send
    
    If WinHttp.Status = 200 Then
        If IsEmpty(WinHttp.responseBody) Then Err.Raise vbObjectError, , "No bytes returned!"
        If UBound(WinHttp.responseBody) = 0 Then Err.Raise vbObjectError, , "No bytes returned!"
        
        '**** SAVE ****
        Dim lSaveFileNum As Long
        Dim sFullFilename As String
        sFullFilename = OpenCleanFileForBinary("JavascriptToVBABin.bin", lSaveFileNum)
        
        
        Dim lRows As Long, lColumns As Long
        lRows = WinHttp.responseBody(0) + WinHttp.responseBody(1) * 256
        lColumns = WinHttp.responseBody(2) + WinHttp.responseBody(3) * 256
        
        Dim lByteLoop As Long
        For lByteLoop = 4 To UBound(WinHttp.responseBody)
            Put lSaveFileNum, , CByte(WinHttp.responseBody(lByteLoop))
        Next lByteLoop
        Close lSaveFileNum
        
        '**** LOAD ****
        
        ReDim vGrid(0 To lRows - 1, 0 To lColumns - 1) As Variant
        Dim lLoadFileNum As Long
        lLoadFileNum = OpenFileForBinary(sFullFilename)
        Get lLoadFileNum, , vGrid
        Close lLoadFileNum
        
        '**** WRITE TO WORKSHEET CELLS ****
        
        Stop '* next line will overwrite cells!! please save your work!!
        Sheet1.Range("a11").Resize(lRows, lColumns).Value = vGrid
        Stop '* Observe the cells on the worksheet
    End If
End Sub

Final Thoughts

It is a shame that the serialization format does not natively include the dimensions of the array block/grid as I could shave even more lines of code on the VBA side. It is also a shame we have to write the file to disk instead of being able to load directly into memory; there is the option of using a RAM disk to speed the file operation. In the meantime I feel I can write JavaScript Chrome extensions that could now transmit blocks of cells to an Excel client in VBA's native serialization format. Cool!

Sunday, 14 April 2019

Multiple instances of Excel

Past versions of Excel will create new processes when asked and one can go look at the Task Manager for proof. Of late Excel will merge instances. For most people this is probably a good feature. However if you want to restore process isolation then one has to fiddle in the registry.

This Microsoft Support article shows how to add a registry setting but it does not work for me!

In the meantime I have discovered that holding the ALT key down whilst launching new Excel instance throws a dialog box saying "Do you want to start a new instance of Excel? (Yes/No)", this is shown in this Microsoft article. This is a good workaround for the time being but I would like the registry setting to work.

if you happen to know please add a comment below or tweet me @excel_developer or you can answer the StackOverflow question I have opened .

On StackOverflow I have been advised from that a command line Excel.exe /x – will generate new instance.

Monday, 28 January 2019

VBA - Code to get Excel, Word, PowerPoint from window handle

The following code shows three Office applications accessible from their windows handle (please ensure you have them running before testing). They work via the Accessibility API. I had some fun writing code to find the general pattern and that generic code follows in the next post.

  1. Option Explicit
  2. Option Private Module
  3.  
  4. Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc.dll" ( _
  5.     ByVal hwnd As LongPtr, ByVal dwId As LongByRef riid As Any, ByRef ppvObject As ObjectAs Long
  6.  
  7. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
  8.     (ByVal hWnd1 As LongByVal hwnd2 As LongByVal lpsz1 As StringByVal lpsz2 As StringAs Long
  9.  
  10. Public Function GetExcelAppObjectByIAccessible() As Object
  11.     Dim guid(0 To 3) As Long, acc As Object
  12.     guid(0) = &H20400 : guid(1) = &H0 : guid(2) = &HC0 : guid(3) = &H46000000
  13.  
  14.     Dim alHandles(0 To 2) As Long
  15.     alHandles(0) = FindWindowEx(0, 0, "XLMAIN", vbNullString)
  16.     alHandles(1) = FindWindowEx(alHandles(0), 0, "XLDESK", vbNullString)
  17.     alHandles(2) = FindWindowEx(alHandles(1), 0, "EXCEL7", vbNullString)
  18.     If AccessibleObjectFromWindow(alHandles(2), -16&, guid(0), acc) = 0 Then
  19.         Set GetExcelAppObjectByIAccessible = acc.Application
  20.     End If
  21. End Function
  22.  
  23.  
  24. Public Function GetWordAppObjectByIAccessible() As Object
  25.     Dim guid(0 To 3) As Long, acc As Object
  26.     guid(0) = &H20400 : guid(1) = &H0 : guid(2) = &HC0 : guid(3) = &H46000000
  27.  
  28.     Dim alHandles(0 To 3) As Long
  29.     alHandles(0) = FindWindowEx(0, 0, "OpusApp", vbNullString)
  30.     alHandles(1) = FindWindowEx(alHandles(0), 0, "_WwF", vbNullString)
  31.     alHandles(2) = FindWindowEx(alHandles(1), 0, "_WwB", vbNullString)
  32.     alHandles(3) = FindWindowEx(alHandles(2), 0, "_WwG", vbNullString)
  33.     If AccessibleObjectFromWindow(alHandles(3), -16&, guid(0), acc) = 0 Then
  34.         Set GetWordAppObjectByIAccessible = acc.Application
  35.     End If
  36. End Function
  37.  
  38.  
  39. Public Function GetPowerPointAppObjectByIAccessible() As Object
  40.     Dim guid(0 To 3) As Long, acc As Object
  41.     guid(0) = &H20400 : guid(1) = &H0 : guid(2) = &HC0 : guid(3) = &H46000000
  42.  
  43.     Dim alHandles(0 To 2) As Long
  44.     alHandles(0) = FindWindowEx(0, 0, "PPTFrameClass", vbNullString)
  45.     alHandles(1) = FindWindowEx(alHandles(0), 0, "MDIClient", vbNullString)
  46.     alHandles(2) = FindWindowEx(alHandles(1), 0, "mdiClass", vbNullString)
  47.     If AccessibleObjectFromWindow(alHandles(2), -16&, guid(0), acc) = 0 Then
  48.         Set GetPowerPointAppObjectByIAccessible = acc.Application
  49.     End If
  50. End Function
  51.  
  52. Sub TestGetExcelAppObjectByIAccessible()
  53.     Dim obj As Object
  54.     Set obj = GetExcelAppObjectByIAccessible()
  55.     Debug.Print obj.Name
  56. End Sub
  57.  
  58.  
  59. Sub TestGetWordAppObjectByIAccessible()
  60.     Dim obj As Object
  61.     Set obj = GetWordAppObjectByIAccessible()
  62.     Debug.Print obj.Name
  63. End Sub
  64.  
  65.  
  66. Sub TestGetPowerPointAppObjectByIAccessible()
  67.     Dim obj As Object
  68.     Set obj = GetPowerPointAppObjectByIAccessible()
  69.     Debug.Print obj.Name
  70. End Sub
  71.  
  72.  
  73.  
  74.  

We can visualise what is going on with the following output reports, first the Excel windows handles report ...

Next the Word windows handles report ...

Finally the PowerPoint windows handles report ...

Friday, 18 January 2019

VBA - How to tell if running in Excel or Word

Just a quick post. For a demo I wanted to run some code in Microsoft Word instead of Microsoft Excel. So I needed a method to determine in which environment the code was running. I have selected this code which probes the object model; it uses late binding to slyly evade compile errors.

UPDATE

Ignore code below, Application.Name returns "Microsoft Excel" in Excel and "Microsoft Word" in Word

deprecated...


Function ExcelVBA() As Boolean
    On Error GoTo QuickExit
    Dim objApp As Object
    Set objApp = Application
    
    Dim objWbs As Object
    Set objWbs = objApp.Workbooks
    
    ExcelVBA = True
QuickExit:
End Function

Function WinWordVBA() As Boolean
    On Error GoTo QuickExit
    Dim objApp As Object
    Set objApp = Application
    
    Dim objActiveDocument As Object
    Set objActiveDocument = objApp.ActiveDocument
    
    WinWordVBA = True
QuickExit:
End Function

Wednesday, 31 October 2018

C# - Excel Moniker Class to pack cell address to single string

In one single string, I need to encode a path to a block of Excel cells including the correct Excel.exe process (in case there is more than one Excel). I need this for an OLE DB Provider Custom Implementation where one only gets a single string to pack in all the details. As the OLE DB provider is written in C# then I implement an Excel Moniker Class also in C#.

There is an established COM moniker form for an Excel cell address qualified by worksheet, workbook and file location. I use this as the base of my moniker. I then bolt on the Hwnd of the specific Excel session as a prefix.

COM Monikers To Specify Excel Ranges

I do not want to replicate the COM specification here but there is such a thing as a COM moniker. A COM moniker is a bit like a URL (web address) or a file path. COM monikers can be composed of subtype COM moniker such as file moniker. The segments of such composite monikers by convention are frequently separated by the bang (exclamation mark) '!' . It is possible for a composite moniker to be parsed segment by segment passing control of each segment parsing to a separate component. This is emblematic of COM's component design.

An example of a composite moniker is an Excel cell located in another workbook. But first, let's build it up piece by piece. N.B. all the following examples show an equals sign as if in a formula. If on the same sheet a cell address requires no qualification, e.g. =$A$1. A cell address on another sheet requires the sheet name as a qualifier e.g. =Sheet2!$A$1 (note the bang '!' as separator) . A problem arises if the other sheet has a space in its name as this then requires surrounding quotes, e.g. ='Sheet 3'!$E$8 . A cell address in another workbook requires further qualification with the workbook enclosed in square brackets ...

=[TestClient.xlsm]Sheet5!$C$6

If there is a space in the workbook name then this (just like a worksheet name) has to be surrounded in single quotes.

='[Book With Space in Name.xlsx]Sheet1'!$D$6

Moreover, sometimes a workbook needs to be qualified by its full path so a full moniker could look like ...

=[C:\Temp\TestClient.xlsm]Sheet5!$C$6

Then there is the issue of using a named range instead of a cell address. Furthermore, a named range can be either local or global which gives us two extra forms...

=[TestClient.xlsm]Sheet5!LocalName
=[TestClient.xlsm]!GlobalName

So lots of logic to program into a moniker class.

Additionally specifying Excel session with Hwnd

As highlighted in previous post, it is possible to identify and reach a specify Excel session running by means of its Hwnd by using the IAccessible interface. I use this in the code to identify the correct and specific Excel.exe session in case there are two. I bolt on the Hwnd as a prefix separated by a tick ` .

XlMoniker Class Source Code

So the following is C# code to be housed in an assembly that is registered for interop (Visual Studio will need admin rights to register).

Public XlMoniker Class and IXlMoniker

There is more than one class in the code below and so it is required to distinguish in this commentary. To expose functionality to VBA we need to ship a COM interface, that is IXlMoniker and also we need to shiop a COM class, XlMoniker that implements the interface IXlMoniker. There are three methods, GetExcelByHwnd was covered in prior post. ExcelRangeToMoniker takes a range and returns a moniker string. GetExcelRangeFromMoniker takes a moniker string and returns a range.

Internal XlMonikerParser Class

I have separated out the parsing and string handling in a separate class XlMonikerParser. This has no COM interface and so is not exposed to VBA. The code in this class lends itself to unit testing and the Unit test code is given below.

using System;
using System.Runtime.InteropServices;

namespace XlMoniker
{
    [ComVisible(true)]
    public interface IXlMoniker
    {
        bool GetExcelByHwnd(int lhwndApp, ref object app);
        bool GetExcelRangeFromMoniker(string sMoniker, ref object rngRetVal);
        string ExcelRangeToMoniker(object rng);
    }

    public class XlMonikerParser
    {
        public bool ParseMoniker(string sFullMoniker, out string sHwnd, out string sWorkbook,
                    out string sWorksheet, out string sCellAddress)
        {
            bool retval = false; sHwnd = ""; sWorkbook = ""; sWorksheet = ""; sCellAddress = "";

            if (this.ParseLeadingHwnd(sFullMoniker, out sHwnd, out string sFileAndCellAddressMoniker))
            {
                if (this.ParseWorkbookAndSheetFromCellAddress(sFileAndCellAddressMoniker, out string sWorkbookAndSheet, out sCellAddress))
                {
                    if (this.ParseWorkbookFromSheet(sWorkbookAndSheet, out sWorkbook, out sWorksheet))
                    {
                        return true;
                    }
                }
            }

            return retval;
        }

        public bool ParseWorkbookFromSheet(string sWorkbookAndSheet, out string sWorkbook,
                    out string sWorksheet)
        {
            bool retval = false; sWorkbook = ""; sWorksheet = "";
            // if workbook or sheet name contain a space then single quotes wrap them isolating them from the cell address
            // '[Book With Space in Name.xlsx]Sheet1'
            // [TestClient.xlsm]Sheet1


            string[] splitOnSingleQuotes = sWorkbookAndSheet.Split(''');
            string sWithoutSingleQuotes = splitOnSingleQuotes.Length == 3 ? splitOnSingleQuotes[1] : sWorkbookAndSheet;

            char[] squareBrackets = new char[] { '[', ']' };
            string[] splitOnSquareBrackets = sWithoutSingleQuotes.Split(squareBrackets);
            if (splitOnSquareBrackets.Length == 3)
            {
                sWorkbook = splitOnSquareBrackets[1];
                sWorksheet = splitOnSquareBrackets[2];
                return true;
            }
            else if (splitOnSquareBrackets.Length == 1)
            {
                sWorkbook = splitOnSquareBrackets[0];
                sWorksheet = ""; // possibly a global name
                return true;
            }

            return retval;
        }

        public bool ParseWorkbookAndSheetFromCellAddress(string sFileAndCellAddressMoniker, out string sWorkbookAndSheet,
                    out string sCellAddress)
        {
            bool retval = false; sWorkbookAndSheet = ""; sCellAddress = "";

            string[] splitOnBang = sFileAndCellAddressMoniker.Split('!');
            // expecting only one bang to split the workbook and sheet name from the cell address , so two elements
            if (splitOnBang.Length == 2)
            {
                sWorkbookAndSheet = splitOnBang[0];
                sCellAddress = splitOnBang[1];
                return true;
            }

            return retval;
        }

        public bool ParseLeadingHwnd(string sFullMoniker, out string sHwnd, out string sFileAndCellAddressMoniker)
        {
            bool retval = false;
            sHwnd = "";
            sFileAndCellAddressMoniker = "";

            string[] splitOnTick = sFullMoniker.Split('`');
            // expecting only one tick to split the Hwnd from the rest of the moniker, so two elements
            if (splitOnTick.Length == 2)
            {
                sHwnd = splitOnTick[0];
                sFileAndCellAddressMoniker = splitOnTick[1];
                return true;
            }

            return retval;
        }
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IXlMoniker))]
    [ComVisible(true)]
    public class XlMoniker : IXlMoniker
    {
        const char separator = '`';

        [DllImport("user32.dll", SetLastError = true)]
        static extern IntPtr FindWindowEx(IntPtr hwndParent, IntPtr hwndChildAfter, string lpszClass, string lpszWindow);


        [DllImport("oleacc.dll", SetLastError = true)]
        internal static extern int AccessibleObjectFromWindow(IntPtr hwnd, uint id, ref Guid iid,
                                                    [In, Out, MarshalAs(UnmanagedType.IUnknown)] ref object ppvObject);

        bool IXlMoniker.GetExcelByHwnd(int lhwndApp2, ref object appRetVal)
        {
            bool bRetVal = false;

            IntPtr lhwndApp = (IntPtr)lhwndApp2;

            IntPtr lHwndDesk = FindWindowEx(lhwndApp, IntPtr.Zero, "XLDESK", "");
            if (lHwndDesk != IntPtr.Zero)
            {

                IntPtr lHwndExcel7 = FindWindowEx(lHwndDesk, IntPtr.Zero, "EXCEL7", null);
                if (lHwndExcel7 != IntPtr.Zero)
                {
                    Guid IID_IDispatch = new Guid("{00020400-0000-0000-C000-000000000046}");
                    const uint OBJID_NATIVEOM = 0xFFFFFFF0;
                    object app = null;
                    if (AccessibleObjectFromWindow(lHwndExcel7, OBJID_NATIVEOM, ref IID_IDispatch, ref app) == 0)
                    {
                        dynamic appWindow = app;
                        appRetVal = appWindow.Application;
                        return true;
                    }
                }
            }
            return bRetVal;
        }


        bool IXlMoniker.GetExcelRangeFromMoniker(string sMoniker, ref object rngRetVal)
        {
            bool retval = false;

            XlMonikerParser parser = new XlMonikerParser();
            retval = parser.ParseMoniker(sMoniker, out string sHwnd, out string sWorkbook,
                        out string sWorksheet, out string sCellAddress);
            if (retval)
            {
                if (int.TryParse(sHwnd, out int lHwnd))
                {
                    dynamic xlApp = null;
                    if (((IXlMoniker)this).GetExcelByHwnd(lHwnd, ref xlApp))
                    {

                        if (FindWorkbookByFullName(sWorkbook, xlApp, out dynamic wbFound))
                        {
                            if (sWorksheet.Length == 0)
                            {
                                // perhaps a global name
                                if (TryGetName(sCellAddress, wbFound, out dynamic nameFound))
                                {
                                    rngRetVal = nameFound.RefersToRange;
                                    return true;
                                }
                            }
                            else
                            {
                                if (FindWorksheetByName(sWorksheet, wbFound, out dynamic wsFound))
                                {
                                    // perhaps a local name
                                    if (TryGetName(sCellAddress, wsFound, out dynamic nameFound))
                                    {
                                        rngRetVal = nameFound.RefersToRange;
                                        return true;
                                    }
                                    else
                                    {
                                        // here it can only be a cell address
                                        if (TryGetRange(wsFound, sCellAddress, out dynamic range))
                                        {
                                            rngRetVal = range;
                                            return true;
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
            }

            return retval;
        }

        bool FindWorkbookByFullName(string sWorkbookFullName, dynamic xlApp, out dynamic wbFound)
        {
            bool retVal = false;
            wbFound = null;
            if (xlApp != null)
            {
                foreach (var wb in xlApp.workbooks)
                {
                    if (wb.FullName == sWorkbookFullName)
                    {
                        wbFound = wb;
                        return true;
                    }
                }
            }
            return retVal;
        }

        bool FindWorksheetByName(string sWorksheetName, dynamic wb, out dynamic wsFound)
        {
            bool retVal = false;
            wsFound = null;
            if (wb != null)
            {
                foreach (var ws in wb.worksheets)
                {
                    if (ws.Name == sWorksheetName)
                    {
                        wsFound = ws;
                        return true;
                    }
                }
            }
            return retVal;
        }

        bool TryGetName(string sNameName, dynamic wsOrWb, out dynamic nameFound)
        {   // this should work for both the Names collection off the workbook (i.e. global) and off each worksheet (i.e. Local)
            bool retVal = false;
            nameFound = null;
            if (wsOrWb != null)
            {
                try
                {
                    nameFound = wsOrWb.Names.Item(sNameName);
                    retVal = true;
                }
                catch
                {
                    return false;
                }
            }
            return retVal;
        }

        bool TryGetRange(dynamic ws, string sCellAddress, out dynamic range)
        {
            bool retVal = false;
            range = null;
            if (ws != null)
            {
                try
                {
                    range = ws.Range(sCellAddress);
                    return true;
                }
                catch
                {
                    return false;
                }
            }
            return retVal;
        }

        bool IsRangeNamed(dynamic rng, out dynamic nameFound)
        {
            bool retVal = false;
            nameFound = null;

            try
            {
                nameFound = rng.Name;
                return true;
            }
            catch
            { }

            return retVal;
        }

        string IXlMoniker.ExcelRangeToMoniker(dynamic rng)
        {
            string retval = "";
            if (rng != null)
            {
                dynamic ws = null; dynamic wb = null; dynamic xlApp = null; int hwnd;
                try
                {
                    ws = rng.Worksheet;
                    wb = ws.Parent;
                    xlApp = wb.Application;
                    hwnd = xlApp.hwnd();
                }
                catch
                {
                    throw new Exception("Error navigating from Range->Worksheet->Parent(Workbook)->Application->Hwnd!");
                }

                try
                {
                    string hwndPrefix = hwnd.ToString() + separator.ToString();
                    string sWorkbookFullName = wb.FullName;
                    string sWorksheetName = ws.Name;

                    if (IsRangeNamed(rng, out dynamic nameFound))
                    {   // range is named, but global or local, presence of ! indicates local
                        string sName = nameFound.Name;
                        bool quoteWorkbook = sWorkbookFullName.Contains(" ");
                        bool quoteWorksheet = sWorksheetName.Contains(" ");

                        if (sName.Contains("!"))
                        {   // it's local 
                            // use single quotes if there is a space in workbook name or sheetname
                            if (quoteWorkbook || quoteWorksheet)
                            {
                                return hwndPrefix + "'[" + sWorkbookFullName + "]" + sName;
                            }
                            else
                            {
                                return hwndPrefix + "[" + sWorkbookFullName + "]" + sName;
                            }
                        }
                        else
                        {   // it's global
                            // use single quotes if there is a space in workbook name
                            if (quoteWorkbook)
                            {
                                return hwndPrefix + "'[" + sWorkbookFullName + "]'!" + sName;
                            }
                            else
                            {
                                return hwndPrefix + "[" + sWorkbookFullName + "]!" + sName;
                            }
                        }
                    }
                    else
                    {   // range is not named just a cell address, so expect a worksheetname
                        if (sWorkbookFullName.Contains(" ") || sWorksheetName.Contains(" "))
                        {
                            return hwndPrefix + "'[" + sWorkbookFullName + "]" + sWorksheetName + "'!" + rng.Address;
                        }
                        else
                        {
                            return hwndPrefix + "[" + sWorkbookFullName + "]" + sWorksheetName + "!" + rng.Address;
                        }
                    }
                }
                catch
                {
                    throw new Exception("Error building moniker string!");
                }
            }
            return retval;
        }
    }

}

VBA Client Code

So this is VBA code to test our class. Though the real test is when I blog an OLEDB Provider that accepts a cell moniker to generate a table, that is upcoming, watch this blog!

Option Explicit
Option Private Module

Private moXlMoniker As SimpleOLEDBProvider1.XlMoniker

Public Function GetXlMoniker() As SimpleOLEDBProvider1.XlMoniker
    If moXlMoniker Is Nothing Then
        Set moXlMoniker = New SimpleOLEDBProvider1.XlMoniker
    End If
    Set GetXlMoniker = moXlMoniker
End Function

Public Sub ResetXlMoniker()
    Set moXlMoniker = Nothing
End Sub

Private Sub Test_XlMoniker_GetExcelRange2()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim sht1 As Excel.Worksheet
    Set sht1 = ThisWorkbook.Worksheets("Sheet1")
    
    Dim sHwnd As String
    sHwnd = Application.hwnd & "`"
    
    Dim sMonikerPart1 As String
    
    If InStr(1, ThisWorkbook.FullName, " ", vbTextCompare) > 0 Then
        sMonikerPart1 = sHwnd & "'[" & ThisWorkbook.FullName & "]"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A11:B14")) = sMonikerPart1 & "Sheet1'!$A$11:$B$14"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A1:B4")) = sMonikerPart1 & "'!GlobalName"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("LocalName")) = sMonikerPart1 & "'Sheet1!LocalName"
    Else
        sMonikerPart1 = sHwnd & "[" & ThisWorkbook.FullName & "]"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A11:B14")) = sMonikerPart1 & "Sheet1!$A$11:$B$14"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("A1:B4")) = sMonikerPart1 & "!GlobalName"
        Debug.Assert oMoniker.ExcelRangeToMoniker(sht1.Range("LocalName")) = sMonikerPart1 & "Sheet1!LocalName"
    End If
    
End Sub



Private Sub Test_XlMoniker_GetExcelRange()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim vSetupValues As Variant
    vSetupValues = Application.[{"ColorName","ColorRGB";"Red","FF0000";"Green", "00FF00";"Blue" ,"0000FF"}]

    ThisWorkbook.Worksheets("Sheet1").Range("A1:B4").Value2 = vSetupValues

    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!A1") = "$A$1"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!A1:b4") = "$A$1:$B$4"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet2!B1:C4") = "$B$1:$C$4"

    ThisWorkbook.Worksheets("Sheet1").Range("A1:B4").Name = "GlobalName"
    
    Dim rngGlobalName As Excel.Range
    Set rngGlobalName = ThisWorkbook.Names.Item("GlobalName").RefersToRange
    
    
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]!GlobalName") = "$A$1:$B$4"
    ThisWorkbook.Worksheets("Sheet1").Range("B1:C4").Name = "Sheet1!LocalName"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!LocalName") = "$B$1:$C$4"
    Debug.Assert GetExcelRangeAddress(oMoniker, Application.hwnd & "`[" & ThisWorkbook.FullName & "]Sheet1!$D5:E7") = "$D$5:$E$7"
End Sub

Private Function GetExcelRangeAddress(ByVal oMoniker As SimpleOLEDBProvider1.XlMoniker, ByVal sMoniker As String) As String
    Dim rng As Excel.Range
    Debug.Assert oMoniker.GetExcelRangeFromMoniker(sMoniker, rng)
    GetExcelRangeAddress = rng.Address
End Function

Private Sub Test_XlMoniker_GetExcelByHwnd()

    Dim oMoniker As SimpleOLEDBProvider1.XlMoniker
    Set oMoniker = New SimpleOLEDBProvider1.XlMoniker
    
    Dim obj As Excel.Application
    If oMoniker.GetExcelByHwnd(Application.hwnd, obj) Then
        Debug.Assert obj Is Application
    End If


End Sub

Private Sub GlobalName()
    
    Dim namGlobal As Excel.Name
    Set namGlobal = ThisWorkbook.Names.Item("GlobalName")
    Debug.Assert Not namGlobal Is Nothing
    Debug.Assert namGlobal.RefersToRange.Address = "$A$1:$B$4"
    
    Dim namLocal As Excel.Name
    Set namLocal = ThisWorkbook.Worksheets("Sheet1").Names.Item("LocalName")
    Debug.Assert Not namLocal Is Nothing

    Dim namGlobal2 As Excel.Name
    Set namGlobal2 = ThisWorkbook.Names.Item("GlobalName")

    Stop

End Sub

XlMonikerParser Unit Tests

As promised here is the unit test code for the XlMonikerParser class. I must say I really like the testing support in Visual Studio 2017. Far better than unit tests in VBA!

using XlMoniker;
using Microsoft.VisualStudio.TestTools.UnitTesting;

namespace UnitTestProject1
{
    [TestClass]
    public class UnitTest1
    {
        [TestMethod]
        public void TestMethod1()
        {
            XlMonikerParser parser = new XlMonikerParser();
            string sHwnd;
            string sFileAndCellAddressMoniker;

            bool parsed = parser.ParseLeadingHwnd("1234`'[foo bar.xlsx]!Sheet1", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "'[foo bar.xlsx]!Sheet1");

            parsed = parser.ParseLeadingHwnd("1234`'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "'[Book With Space in Name.xlsx]Sheet1'!$D$3");

            parsed = parser.ParseLeadingHwnd("1234`TestClient.xlsm!GlobalName", out sHwnd, out sFileAndCellAddressMoniker);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sFileAndCellAddressMoniker == "TestClient.xlsm!GlobalName");
        }

        [TestMethod]
        public void TestMethod2()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sWorkbookAndSheet; string sCellAddress;

            bool parsed = parser.ParseWorkbookAndSheetFromCellAddress("'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sWorkbookAndSheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbookAndSheet == "'[Book With Space in Name.xlsx]Sheet1'");
            Assert.IsTrue(sCellAddress == "$D$3");

            parsed = parser.ParseWorkbookAndSheetFromCellAddress("TestClient.xlsm!GlobalName", out sWorkbookAndSheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbookAndSheet == "TestClient.xlsm");
            Assert.IsTrue(sCellAddress == "GlobalName");
        }

        [TestMethod]
        public void TestMethod3()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sWorkbook; string sWorksheet;

            bool parsed = parser.ParseWorkbookFromSheet("'[Book With Space in Name.xlsx]Sheet1'", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "Book With Space in Name.xlsx");
            Assert.IsTrue(sWorksheet == "Sheet1");

            parsed = parser.ParseWorkbookFromSheet("[TestClient.xlsm]Sheet2", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "Sheet2");

            parsed = parser.ParseWorkbookFromSheet("TestClient.xlsm", out sWorkbook, out sWorksheet);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "");
        }

        [TestMethod]
        public void TestMethod4()
        {
            XlMonikerParser parser = new XlMonikerParser();

            string sHwnd; string sWorkbook; string sWorksheet; string sCellAddress;

            bool parsed = parser.ParseMoniker("1234`'[Book With Space in Name.xlsx]Sheet1'!$D$3", out sHwnd, out sWorkbook, out sWorksheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sWorkbook == "Book With Space in Name.xlsx");
            Assert.IsTrue(sWorksheet == "Sheet1");
            Assert.IsTrue(sCellAddress == "$D$3");

            parsed = parser.ParseMoniker("1234`TestClient.xlsm!GlobalName", out sHwnd, out sWorkbook, out sWorksheet, out sCellAddress);
            Assert.IsTrue(parsed);
            Assert.IsTrue(sHwnd == "1234");
            Assert.IsTrue(sWorkbook == "TestClient.xlsm");
            Assert.IsTrue(sWorksheet == "");
            Assert.IsTrue(sCellAddress == "GlobalName");
        }
    }
}

Monday, 24 September 2018

VBA - .NET - Writing a System.Collections.SortedList to an Excel Worksheet

I have been playing around with some .NET objects that are creatable and usable from VBA. I was wondering if I could stop using Scripting.Dictionary and start using the .net collections classes. I use Scripting.Dictionary for a great many use cases because it exports variants arrays which are easily passed around and pastable onto a worksheet. What would code to write the contents of a System.Collections.SortedList look like?

On a documentation note, we have to wrestle with the lack of Intellisense (even if you do early bind to mscorlib!), I will return to that topic soon but for the meantime see here for a list of methods and properties of SortedList. I investigated them for a while and here are my findings.

We can use SortedList.GetKeyList() directly ourselves or we can pass the return result to ArrayList.AddRange(). This gives rise to three different approaches and code is given below for each. Enjoy!

Option Explicit

Function CreateSortedList() As Object
    '* common code to all attempts
    Dim objSortedList As Object ' mscorlib.SortedList
    Set objSortedList = CreateObject("System.Collections.SortedList") 'New mscorlib.SortedList
    objSortedList.Add "Red", 0
    objSortedList.Add "Green", 0
    objSortedList.Add "Blue", 0
    Set CreateSortedList = objSortedList

End Function

Sub WriteASortedListToASheet_UseArrayListToHelp()

    '*
    '* This approach has fewer lines of code but I suspect not the fastest
    '*

    Dim objSortedList As Object ' mscorlib.SortedList
    Set objSortedList = CreateSortedList
    
    '*
    '* calling SortedList.GetKeyList() and passing results to ArrayList
    '*
    
    Dim oKeys As Object
    Set oKeys = CreateObject("System.Collections.ArrayList")
    oKeys.AddRange objSortedList.GetKeyList()

    Sheet1.Cells(1, 1) = "ArrayList.ToArray()"
    Sheet1.Cells(2, 1).Resize(objSortedList.Count, 1).Value2 = Application.Transpose(oKeys.ToArray)

End Sub

Sub WriteASortedListToASheet_ReverseArrayManuallyWithGetKey()

    '*
    '* This approach builds a pastable array manually by looping through for each element
    '*

    Dim objSortedList As Object ' mscorlib.SortedList
    Set objSortedList = CreateSortedList
    
    ReDim vKeyList(1 To objSortedList.Count, 1 To 1)
    Dim lKeyLoop As Long
    For lKeyLoop = 0 To objSortedList.Count - 1
        vKeyList(lKeyLoop + 1, 1) = objSortedList.GetKey(lKeyLoop)
    
    Next lKeyLoop
    Sheet1.Cells(1, 3) = "GetKey()"
    Sheet1.Cells(2, 3).Resize(objSortedList.Count, 1).Value2 = vKeyList

End Sub

Sub WriteASortedListToASheet_ReverseArrayManuallyWithGetKeyList()

    '*
    '* This approach builds a paste-able array manually by looping through for each element of a KeyList
    '*

    Dim objSortedList As Object ' mscorlib.SortedList
    Set objSortedList = CreateSortedList
        
    Dim objList As Object 'IList
    Set objList = objSortedList.GetKeyList()

    ReDim vKeyList(1 To objSortedList.Count, 1 To 1)
    Dim lKeyLoop As Long
    For lKeyLoop = 0 To objSortedList.Count - 1
        vKeyList(lKeyLoop + 1, 1) = objList.Item(lKeyLoop)
    
    Next lKeyLoop
    
    Sheet1.Cells(1, 5) = "GetKeyList()"
    Sheet1.Cells(2, 5).Resize(objSortedList.Count, 1).Value2 = vKeyList

End Sub

Friday, 29 June 2018

Python - Excel - Scripting Excel Objects and Files

So it's Python month on this Excel Development Platform blog where I showcase interesting Python technologies that might be of interest to Excel (VBA) Developers. Python does COM interop so it can script against the Excel Object Model. So what are the options?

Python to replace VBA?

Your first option could be to wait because VBA is old. VBA is as dated as Visual Basic 6.0 (they are essentially the same language). At some point VBA will be replaced. We do not know if VBA will be replaced with C# or VB.NET. YCombinator reports Excel team considering Python as scripting language, asking for feedback. Here is the feedback forum.

If Microsoft does replace VBA with Python I should imagine Microsoft would do a pretty good job of it.

Python COM Interop and Excel, win32com

So VBA scripts against the Excel object model. In fact the Excel object model is exported and exposed to any COM enabled language. Python has COM interop packages and is thus COM enabled. The key package is win32com. Below is some sample code which should be easy to follow for VBA programmers familiar with the Excel object model. The code is taken from Tim Golden's excellent website. Tim Golden has all sorts of excellent Python for windows tips here. I'd like to particularly highlight folder watching which I could use as part of a message queue solution. They leverage the pywin32 library written by Mark Hammond (twitter github ), another superb technologist!

import os, sys  #Written by Tim Golden
import csv
import tempfile
import win32com.client

#
# Cheating slightly because I know a .csv
# file will register as an Excel object
#

filename = tempfile.mktemp (".csv")
f = open (filename, "wb")
writer = csv.writer (f)
writer.writerows (range (i, i+5) for i in range (10))
f.close ()

#
# NB filename must (in effect) be absolute
#
os.startfile (filename)

wb1 = win32com.client.GetObject (filename)
wb1_c11 = wb1.ActiveSheet.Cells (1, 1)
print wb1_c11.Value
wb1_c11.Value += 1

xl = win32com.client.GetObject (Class="Excel.Application")
# could also use:
# xl = win32com.client.GetActiveObject ("Excel.Application")
xl_c11 = xl.ActiveSheet.Cells (1, 1)
print xl_c11.Value
xl_c11.Value += 1

print wb1_c11.Value
print xl_c11.Value

wb1.Close ()

os.remove (filename)

Python Packages Without Excel.exe

The following packages do not need a running copy of Excel. The authors have very kindly wrestled with the Excel file format specifications and put together code which can either create, read or manipulate Excel files without needing to run a copy of Excel. Economical for Excel licences and also ensures code can run on Linux (where Excel.exe cannot run) for further cost savings.

openpyxl

The documentation states

Openpyxl is a Python library for reading and writing Excel 2010 xlsx/xlsm/xltx/xltm files. It was born from lack of existing library to read/write natively from Python the Office Open XML format.

So this refers the face that Office 2010 introduced new file type options, xlsx and xlsm which are Xml based (and then zipped). To be fair the Xml formats are hard to follow and they have done us a great favour in writing this library. Here is some sample code to get a flavour.

from openpyxl import Workbook
wb = Workbook()

# grab the active worksheet
ws = wb.active

# Data can be assigned directly to cells
ws['A1'] = 42

# Rows can also be appended
ws.append([1, 2, 3])

# Python types will automatically be converted
import datetime
ws['A2'] = datetime.datetime.now()

# Save the file
wb.save("sample.xlsx")

xlsxwriter

Another package written for xlsx (Xml) file types this time written by Jon McNamara (github, twitter). John McNamara is also on cpan.org where has prolifically written many packages in different languages including Lua, Python, Ruby, C and Perl. Here is some sample code.

##############################################################################
#
# A simple example of some of the features of the XlsxWriter Python module.
#
# Copyright 2013-2018, John McNamara, jmcnamara@cpan.org
#
import xlsxwriter


# Create an new Excel file and add a worksheet.
workbook = xlsxwriter.Workbook('demo.xlsx')
worksheet = workbook.add_worksheet()

# Widen the first column to make the text clearer.
worksheet.set_column('A:A', 20)

# Add a bold format to use to highlight cells.
bold = workbook.add_format({'bold': True})

# Write some simple text.
worksheet.write('A1', 'Hello')

# Text with formatting.
worksheet.write('A2', 'World', bold)

# Write some numbers, with row/column notation.
worksheet.write(2, 0, 123)
worksheet.write(3, 0, 123.456)

# Insert an image.
worksheet.insert_image('B5', 'logo.png')

workbook.close()

xlrd

The documentation says

xlrd is a library for reading data and formatting information from Excel files, whether they are .xls or .xlsx files.

So this package can read older formats as well as the newer .xlsx .xlsm (Xml) formats.

xlutils

The documentation describes this as

This package provides a collection of utilities for working with Excel files.

Without delving through all of the documentation I think this library is more file stream based, a bit like SAX for Xml. Here is some sample code defining a filter that allows even rows through but odd rows not ...

>>> from xlutils.filter import BaseFilter
>>> class EvenFilter(BaseFilter):
...
...     def row(self,rdrowx,wtrowx):
...         if not rdrowx%2:
...             self.next.row(rdrowx,wtrowx)
...
...     def cell(self,rdrowx,rdcolx,wtrowx,wtcolx):
...         if not rdrowx%2:
...             self.next.cell(rdrowx,rdcolx,wtrowx,wtcolx)

And here is run through using the filter give above...

>>> from xlutils.filter import process
>>> process(
...     MyReader('test.xls'),
...     MyFilter('before'),
...     EvenFilter(),
...     MyFilter('after'),
...     MyWriter()
...     )
before start
after start
before workbook  test.xls
after workbook  test.xls
before sheet  Sheet1
after sheet  Sheet1
before row 0 0
after row 0 0
before cell 0 0 0 0
after cell 0 0 0 0
before cell 0 1 0 1
after cell 0 1 0 1
before row 1 1
before cell 1 0 1 0
before cell 1 1 1 1
before sheet  Sheet2
after sheet  Sheet2
before row 0 0
after row 0 0
before cell 0 0 0 0
after cell 0 0 0 0
before cell 0 1 0 1
after cell 0 1 0 1
before row 1 1
before cell 1 0 1 0
before cell 1 1 1 1
before finish
after finish

Thursday, 28 December 2017

Convert Excel Table To JSON with VBA and Javascript running on ScriptControl

Today, I am reminded of a SO answer I gave some time ago which serialises an Excel table to JSON. The code is replicated below. I am reminded because it seems there is JavaScript library called SheetJS. SheetJS would require some time to evaluate to see what it is capable of, hopefully I'll blog about it soon. In the meantime, I am re-publishing the code I wrote to show that actually it is quite trivial and need not involve any VBA string operations. Instead, we leverage the JavaScript language and we call into the Excel object model (probably uses COM under the hood) to get each cell's value.

So I would pass in the range to a JavaScript function and let it iterate over the Excel object model and build the array in JavaScript. Then call a JavaScript library to convert array into a string (hat tip Douglas Crockford) and simply return the string to VBA. So no string operations in VBA.

The JavaScript function is given below but depends upon Douglas Crockford's library at https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js. Save this in a file and then amend VBA code with the correct file path so the JavaScript is loaded into the Microsoft Script Control.


function ExcelTableToJSON(rngTable) {
    try {
        if (rngTable && rngTable['Rows'] && rngTable['Columns']) {
            var rowCount = rngTable.Rows.Count;
            var columnCount = rngTable.Columns.Count;
            var arr = new Array();

            for (rowLoop = 1; rowLoop <= rowCount; rowLoop++) {
                arr[rowLoop - 1] = new Array();
                for (columnLoop = 1; columnLoop <= columnCount; columnLoop++) {
                    var rngCell = rngTable.Cells(rowLoop, columnLoop);
                    var cellValue = rngCell.Value2;
                    arr[rowLoop - 1][columnLoop - 1] = cellValue;
                }
            }
            return JSON.stringify(arr);
        }
        else {
            return { error: '#Either rngTable is null or does not support Rows or Columns property!' };
        }
    }
    catch(err) {
        return {error: err.message};
    }
}


Option Explicit

'In response to
'http://stackoverflow.com/questions/38100193/is-it-possible-in-vba-convert-excel-table-to-json?rq=1
'Is it possible in VBA convert Excel table to json

'Tools->References->
'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx

Private Sub Test()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    oScriptEngine.AddCode GetJavaScriptLibraryFromWeb("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")

    Dim sJavascriptCode As String
    sJavascriptCode = CreateObject("Scripting.FileSystemObject").GetFile("<<<Your file path to javascript file>>>\ExcelTableToJSON.js").OpenAsTextStream.ReadAll

    oScriptEngine.AddCode sJavascriptCode

    Dim rngTable As Excel.Range
    Set rngTable = ThisWorkbook.Worksheets.Item("Sheet2").Range("A1:B2")

    rngTable.Cells(1, 1) = 1.2
    rngTable.Cells(1, 2) = "red"
    rngTable.Cells(2, 1) = True
    rngTable.Cells(2, 2) = "=2+2"


    Dim sStringified As String
    sStringified = oScriptEngine.Run("ExcelTableToJSON", rngTable)
    Debug.Assert sStringified = "[[1.2,""red""],[true,4]]"

    Stop

End Sub

Public Function GetJavaScriptLibraryFromWeb(ByVal sURL As String) As String

    Dim xHTTPRequest As Object 'MSXML2.XMLHTTP60
    Set xHTTPRequest = VBA.CreateObject("MSXML2.XMLHTTP.6.0")
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    GetJavaScriptLibraryFromWeb = xHTTPRequest.responseText

End Function

Tuesday, 10 October 2017

JSON to Excel Cells Serialization

So JSON is becoming a popular serialization format to rival (if not overtake) XML for web services. If you're an Excel VBA programmer and you want to dump some JSON into cells then you could use the ScriptControl to parse this, see my blog entry here. However, it is worth pointing out that Excel has a cell value serialization format which call be demonstrated thus ...


Sub XlSerialization1()
    Dim v
    v = [{1,2;"foo",4.5}]

    Debug.Assert v(1, 1) = 1
    Debug.Assert v(1, 2) = 2
    Debug.Assert v(2, 1) = "foo"
    Debug.Assert v(2, 2) = 4.5

    '* write all cells in one line
    Sheet1.Cells(1, 1).Resize(2, 2).Value2 = v
End Sub

So the square brackets surround the curly bracketed expression, square brackets is a VBA shorthand for evaluate, so the core syntax is the curly-bracketed expression. The given form is for literals where the cell values are constant. What happens when you want to use a variable, this is when you need Application.Evaluate thus ...


Sub XlSerialization2()

    Dim s As String
    s = "{1,2;""foo"",4.5}"
    
    Dim appEval
    appEval = Application.Evaluate(s)

    Debug.Assert appEval(1, 1) = 1
    Debug.Assert appEval(1, 2) = 2
    Debug.Assert appEval(2, 1) = "foo"
    Debug.Assert appEval(2, 2) = 4.5

    '* write all cells in one line
    Sheet1.Cells(4, 1).Resize(2, 2).Value2 = appEval
End Sub

If we want to write a 2D JSON array to cells we can convert the JSON string to this Excel serialization string and then we can get a Variant in one step and write the Variant in one step. For large arrays I should think this would be faster than looping through each element in VBA.

It might be possible to use regular expressions to extract and convert the cells values but instead I chose let a JavaScript engine/parser parse a JSON string and leveraged this thus...


Sub TestJSONArrayToXlArray()
    
    '* [[1,2],[3,4]] is a JSON 2D array, ideal for writing to cells
    Dim vXlArray As Variant
    vXlArray = JsonArrayToXlArray("[[1,2],[3,4]]")

    Debug.Assert vXlArray(1, 1) = 1
    Debug.Assert vXlArray(1, 2) = 2
    Debug.Assert vXlArray(2, 1) = 3
    Debug.Assert vXlArray(2, 2) = 4

    
    '* write all cells in one line
    Sheet1.Cells(1, 4).Resize(2, 2).Value2 = vXlArray


    '* [['foo','bar'],['baz','barry']] is a JSON 2D array, ideal for writing to cells
    Dim vXlArray2 As Variant
    vXlArray2 = JsonArrayToXlArray(Replace("[['foo','bar'],['baz','barry']]", "'", """"))

    Debug.Assert vXlArray2(1, 1) = "foo"
    Debug.Assert vXlArray2(1, 2) = "bar"
    Debug.Assert vXlArray2(2, 1) = "baz"
    Debug.Assert vXlArray2(2, 2) = "barry"

    '* write all cells in one line
    Sheet1.Cells(4, 4).Resize(2, 2).Value2 = vXlArray2


End Sub

Private Function JsonArrayToXlArray(sJson2dArray As String) As Variant
    
    Static oScriptEngine As ScriptControl
    If oScriptEngine Is Nothing Then
        Set oScriptEngine = New ScriptControl
        oScriptEngine.Language = "JScript"
        oScriptEngine.AddCode "function quoteString(cell) {    " & _
                              "  if(typeof cell === 'string' || cell instanceof String)    {" & _
                              "    return '""' + cell +'""';;} else {return cell.toString();} }"
        
        Debug.Assert oScriptEngine.Run("quoteString", 8) = "8"
        Debug.Assert oScriptEngine.Run("quoteString", "bar") = """bar"""
        
        oScriptEngine.AddCode _
            "function JsonArrayToXlArray(array) { " & _
            "  var xlArray=''; " & _
            "  for (var i=0; i0) {xlArray=xlArray+';';} " & _
            "    for (var j=0;j0) {row=row+',';} " & _
            "      row=row + quoteString(array[i][j]); " & _
            "    } " & _
            "    xlArray=xlArray+row; " & _
            "  } " & _
            "  xlArray='{' + xlArray + '}'; " & _
            "return xlArray; }"
    End If
    
    Dim objJson2dArray As Object
    Set objJson2dArray = oScriptEngine.Eval("(" + sJson2dArray + ")")
    
    Dim sXlArray As String
    sXlArray = oScriptEngine.Run("JsonArrayToXlArray", objJson2dArray)
    
    JsonArrayToXlArray = Application.Evaluate(sXlArray)
End Function



If you want to see the Javascript better ...


var array=[['foo',2],[3,4]];
var xlArray="";

xlArray=JsonArrayToXlArray(array);
alert(xlArray);

function JsonArrayToXlArray(array) {
var xlArray=''; 
for (var i=0; i0) {xlArray=xlArray+';';}
    for (var j=0;j0) {row=row+',';}   
        row=row + quoteString(array[i][j]);    
    }
    xlArray=xlArray+row;
} 
xlArray='{' + xlArray + '}';
return xlArray;
}

function quoteString(cell) {
   if(typeof cell === 'string' || cell instanceof String)
   {return '"' + cell +'"';;}
   else
   {return cell.toString();}
}