Showing posts with label Microsoft. Show all posts
Showing posts with label Microsoft. Show all posts

Sunday, 22 August 2021

How do web servers tell the (Windows) operating system which port to listen on?

So I chanced upon a beautiful piece of sample C++ whilst wondering around the Microsoft website. Essentially the code creates an http server sample application. If we browse the code we can see that there is a line to register interest in a URL of which the port is a segment by calling HttpAddUrl.

Before we call HttpAddUrl we have to call first HttpInitialize and then httpcreatehttphandle; the latter passes a structure that we can pass into HttpAddUrl.

But now we can get to the heart of the issue: how to register interest in a port. Here is the method signature of HttpAddUrl.

HTTPAPI_LINKAGE ULONG HttpAddUrl(
  HANDLE RequestQueueHandle,
  PCWSTR FullyQualifiedUrl,
  PVOID  Reserved
);

The second parameter is a string, a URLPrefix string to be precise. The syntax and examples are given below.

"scheme://host:port/relativeURI"

https://www.adatum.com:80/vroot/
https://adatum.com:443/secure/database/
https://+:80/vroot/

To start receiving requests the sample code gives a function which handles each request, in this code there is yet another Windows API call this time to HttpReceiveHttpRequest.

And that is enough code, although we should tidy up and this is given in the code. Hopefully this clarifies the relationship between a web server and the (Windows) operating system.

There are some details about upgrading the code when using HTTP Server API Version 2.0. Other than that the code stands

All of this is for Microsoft Windows obviously, but I should imagine the process is similar for Linux and Mac OS.

Previously I have given code (twice!) that allows Excel to run as a web server: once in C# and once in Python. So, it would appear that for the adventurous some C++ Excel addin could also implement an HTTP web server! So that's a third way!

Tuesday, 26 February 2019

VBA - Installing and calling Microsoft Message Queue

A question was asked on StackOverflow the solution to which was using a message queue. The questioner had a database and wanted notification to reach his Excel workbook application when the number of rows in a database table changed. On the database side one would use a database trigger to detect insertions but how would the database trigger notify Excel?

Whilst it is possible to open an ADODB Connection and sink events, holding that connection open for however long seemed wrong. Better if the notification was loosely coupled, so the database trigger could send a message to a message queue which would reliable be received by Windows and readable for later. A COM event is not persisted, if the Excel workbook application was closed or not running for some reason then the COM event would be lost.

So in the given scenario a message queue is better than sinking COM events. So for the benefit of that StackOverflower, this post highlights how to install and call Windows Message Queue.

Steps to install Microsoft Message Queue

I have verified these steps on my Windows 10 box

  1. Open Control Panel (classic view I loathe Windows 8 app view).
  2. Within control panel click on Programs and Features
  3. Within Programs and Features on the left hand side click on the blue yellow chequered shield labelled 'Turn Windows features on or off'
  4. Within the Windows Features dialog box scroll down until you find Microsoft Message Queue (MSMQ) Server, the check the checkbox and click OK.
  5. Wait patiently as progress dialog box appears for two minutes during install. The messages that pass by are 'Searching for required files', 'Applying changes' and finally 'Windows completed the requested changes.'
  6. Click Close.

Creating a Queue

So to create a queue we have to start with the control panel again. Here are the steps ...

  1. Open Control Panel (classic view I loathe Windows 8 app view).
  2. Within control panel click on Administrative Tools
  3. Within the Administrative Tools explorer click on Computer Management, this launches the Computer Management Microsoft Management Console (MMC)
  4. In the Computer Management MMC expand the Services and Applications tree node, then Message Queueing tree node, then Private Queues tree node
  5. On the Private Queues node right-click to get context menu and select New -> Private Queue
  6. In the New Private Queue give you queue a name, I named mine myfirstqueue and the code samples below are coded to this name but you can obviously change the names to suit.
  7. Click OK and you're done.

Do Add Security

I'm not sitting in an enterprise as I write this so I cannot inform as how to secure your message queue at the enterprise level but obviously you would want to tie down access. As a message queue is a Windows resource then it can be permission-ed like other Windows resources such as directories and printers etc. Indeed the security tab on the queue's properties looks pretty much like a standard Windows permissioning dialog.

Leaving a message queue with no security is a big no-no.

Finding the Message Queue Type Library

So after installing I had thought it would be simple to go to the VBA IDE and find a brand new choice in the Tools->References dialog box but it seems the type library is not registered correctly and so it will not appear in the list. Nevertheless, I have managed to track it down. So in the Tools->References dialog box, click Browse and then go find the file ...

c:\windows\system32\mqoa.tlb

And once checked you should see the following ...

Note how the filename has been resolved to the SysWOW64 directory. Now we can write some VBA code to both send and receive messages.

VBA code to send and receive messages

So here is some client code which was quite straight forward. The only trap was when calling Receive you should definitely supply a timeout otherwise you code will hang which for a single threaded environment such as VBA is bad.

Option Explicit

Private Function GetQueueInfo(Optional ByVal sPrivateQueueName As String = "myfirstqueue") As MSMQ.MSMQQueueInfo
    Dim oQueueInfo As MSMQ.MSMQQueueInfo
    Set oQueueInfo = New MSMQ.MSMQQueueInfo

    Dim sComputerName As String
    sComputerName = Environ$("COMPUTERNAME")
    
    oQueueInfo.FormatName = "direct=os:" + sComputerName + "\PRIVATE$\" + sPrivateQueueName
    Set GetQueueInfo = oQueueInfo
End Function

Sub TestSend()
    Dim oQueueInfo As MSMQ.MSMQQueueInfo
    Set oQueueInfo = GetQueueInfo("myfirstqueue")
    
    Dim oQueue As MSMQ.MSMQQueue
    Set oQueue = oQueueInfo.Open(MSMQ.MQACCESS.MQ_SEND_ACCESS, MSMQ.MQSHARE.MQ_DENY_NONE)
    
    Dim oMessage As MSMQ.MSMQMessage
    Set oMessage = New MSMQ.MSMQMessage
    
    oMessage.Label = "TestMsg"
    oMessage.Body = "Message queues facilitate loose coupling in a distributed component system."
    
    Call oMessage.Send(oQueue)

End Sub

Sub TestReceive()
    Dim oQueueInfo As MSMQ.MSMQQueueInfo
    Set oQueueInfo = GetQueueInfo("myfirstqueue")

    Dim oQueue As MSMQ.MSMQQueue
    Set oQueue = oQueueInfo.Open(MSMQ.MQACCESS.MQ_RECEIVE_ACCESS, MSMQ.MQSHARE.MQ_DENY_NONE)
    
    Dim oMessage As MSMQ.MSMQMessage
    '* IF YOU DO NOT SUPPLY A TIMEOUT THE NEXT LINE WILL HANG!!!
    Set oMessage = oQueue.Receive(ReceiveTimeout:=1000) '1000 milliseconds = 1 second
    If Not oMessage Is Nothing Then
        Debug.Print oMessage.Label
        Debug.Print oMessage.Body
    End If
End Sub

Client C# Code

If in the use case given at the top of the article, the database is SQL Server so the database trigger would be written in C#.

So I have not given any C# code because I think one can easily use a Primary Interop Assembly to deal with a COM library so the above code can be easily translated. However, if writing a .NET language you should use the .NET API and the System.Messaging namespace is where you will find the equivalent .NET objects.

Client Python Code

If the database in the use case is PostgreSQL one can write database triggers in Python and so some Python code would be useful.

So here is a good link to an great article Send MSMQ messages using python and actually that article inspired me to write this one.

Friday, 12 October 2018

VBA - Microsoft.ACE.OLEDB.12.0 - Slow Text Files

Summary: Skip using Text Files with Microsoft.ACE.OLEDB.12.0 because it is just too slow.

Previously, I had discovered that the Microsoft.ACE.OLEDB.12.0 handles databases stored in Html files but I found that to be unsatisfactory because of lack of schemas.

Exporting to Text Files outputs a schema. Indeed, an aggregated schema is built if one exports more than one table. So far so good.

Unfortunately, doing a simple query takes half a second and this looks like overhead, not at all acceptable. Connection pooling does not help. I'm guessing that the overhead is re-reading the schema and re-importing the file.

Depositing code below but skipping a commentary because I want to move on the next database technology candidate.

Option Explicit
Option Private Module

'* Tools -> References
'* ADODB  Microsoft ActiveX Data Objects 6.1 Library  C:\Program Files (x86)\Common Files\System\ado\msado15.dll
'* ADOX   Microsoft ADO Ext. 6.0 for DDL and Security C:\Program Files (x86)\Common Files\System\ado\msadox.dll


Private Const msOrdersTextFile As String = "Orders.txt"
Private Const msCustomersTextFile As String = "Customers.txt"


Public Function TextfilesDbFolder() As String
    Static fso As New Scripting.FileSystemObject
    
    Dim fldTemp As Scripting.Folder
    Set fldTemp = fso.GetFolder(Environ$("Temp"))
    
    Dim sFldTextfilesDb As String
    sFldTextfilesDb = fso.BuildPath(fldTemp.Path, "TextfilesDb")
    If fso.FolderExists(sFldTextfilesDb) Then
        TextfilesDbFolder = sFldTextfilesDb
    Else
        fso.CreateFolder sFldTextfilesDb
        TextfilesDbFolder = sFldTextfilesDb
    End If
        
End Function

Private Sub SetUpSomeData()
    '* WARNING this will wipe data!
    Dim sht As Excel.Worksheet
    Set sht = ThisWorkbook.Worksheets.Item("Sheet1")
    sht.Cells.Clear

    '*
    '* use our array literal trick, for more tricks tips and 'blue sky thinking'
    '* see http://exceldevelopmentplatform.blogspot.com
    '*
    Dim vOrders As Variant
    'vOrders = [{"OrderID","CustomerID","OrderDate";420,2,"10-Oct-2018";421,3,"11-Oct-2018";422,1,"12-Oct-2018"}]
    vOrders = [{"OrderID","CustomerID","OrderDate";420,2,"10-Oct-2018";421,3,"11-Oct-2018";422,1,"12-Oct-2018";423,2,"13-Oct-2018"}]
    sht.Range("A1").Resize(UBound(vOrders) - LBound(vOrders) + 1, 3).Value2 = vOrders
    
    Dim vCustomers As Variant
    vCustomers = [{"CustomerID","CustomerName","ContactName","Country";1,"Big Corp","Mandy","USA";2,"Medium Corp","Bob","Canada";3,"Small Corp","Jose","Mexico"}]
    'sht.Range("e1:h4").Value2 = vCustomers
    sht.Range("e1").Resize(UBound(vCustomers) - LBound(vOrders) + 1, 4).Value2 = vCustomers
    

End Sub



Private Sub TestWriteToTestFile()
    Dim sTextfilesDbFolder  As String
    sTextfilesDbFolder = TextfilesDbFolder
    WriteToTextFile ThisWorkbook.Worksheets.Item("Sheet1").Range("A1").CurrentRegion, sTextfilesDbFolder & msOrdersTextFile
    WriteToTextFile ThisWorkbook.Worksheets.Item("Sheet1").Range("e1").CurrentRegion, sTextfilesDbFolder & msCustomersTextFile
    
End Sub

Private Sub WriteToTextFile(ByVal rngTable As Excel.Range, ByVal sTextFile As String)

    Dim sTableAddress As String
    sTableAddress = "[" & rngTable.Worksheet.name & "$" & rngTable.Address(False, False, xlA1) & "] """

    Dim oConnExcel As ADODB.Connection
    Set oConnExcel = New ADODB.Connection

    If UBound(Split(ThisWorkbook.name, ".")) = 0 Then Err.Raise vbObjectError, , "#Workbook needs a file extension, i.e. saved at least once!"

    '*
    '* we're reading from worksheet so we need the Excel engine
    '*
    oConnExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & ThisWorkbook.FullName & ";" & _
           "Extended Properties='Excel 12.0 Macro;HDR=YES'"

    Dim sFileNameOnly As String, sFolderOnly As String

    If ParseFileName(sTextFile, sFileNameOnly, sFolderOnly) Then

        If Not Dir(sTextFile) = "" Then Kill sTextFile   '* if it exists then delete before re-exporting

        Dim sCmdText As String
        sCmdText = VBA.Replace("SELECT * INTO [%filename%] in %quotedFolder% ""Text;"" FROM %tableName%", "%filename%", sFileNameOnly)
        sCmdText = VBA.Replace(sCmdText, "%quotedFolder%", """" & sFolderOnly & """")
        sCmdText = VBA.Replace(sCmdText, "%tableName%", sTableAddress)

        '*
        '* Text is specified in the command text, no need for a separate connection
        '*
        Debug.Print sCmdText
        oConnExcel.Execute sCmdText
    End If

End Sub


Private Sub TestReadFromTextFile()
    Dim sTextfilesDbFolder  As String
    sTextfilesDbFolder = TextfilesDbFolder

    Static fso As New Scripting.FileSystemObject
    Debug.Assert fso.FolderExists(sTextfilesDbFolder)

    '*
    '* Reuse the connection (pooled connections encouraged)
    '*
    Dim oConnText As ADODB.Connection
    Set oConnText = New ADODB.Connection
    oConnText.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & sTextfilesDbFolder & _
           ";Extended Properties='Text'"

    Dim dtTimeNow As Date
    dtTimeNow = Now()
    Dim lRepeatForTimings As Long
    For lRepeatForTimings = 1 To 10
    'ReadFromTextFile oConnText, "Orders.txt"
    'ReadFromTextFile oConnText, "Customers.txt"
    
    RunJoinQuery oConnText
    
    Next

    Debug.Print (Now() - dtTimeNow) * 86400 '*seconds

    '*
    '* can now close connection
    '*
    oConnText.Close
    Set oConnText = Nothing

End Sub



Private Function ConnectionFactory(ByVal sDbFolder As String) As ADODB.Connection
    Set ConnectionFactory = New ADODB.Connection
    ConnectionFactory.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & sDbFolder & _
           ";Extended Properties='Text'"

End Function
    



Private Function RunJoinQuery(ByVal oConnText As ADODB.Connection) As ADODB.Recordset

    Dim rsJoin As ADODB.Recordset
    Set rsJoin = New ADODB.Recordset

    '*
    '* The Left and Instr functions in the SQL are MSAccess functions, see this link for reference
    '* https://www.w3schools.com/sql/sql_ref_msaccess.asp
    '*
    rsJoin.Open "SELECT O.OrderID ,  Left(C.CustomerName,INSTR(C.CustomerName,' ')-1), C.CustomerName, O.OrderDate From [Orders.txt] as O INNER JOIN [Customers.txt] as C ON O.CustomerID=C.CustomerID ORDER BY O.OrderDate; ", oConnText, CursorTypeEnum.adOpenStatic '* can use CursorTypeEnum.adOpenKeyset
    DumpRecordset rsJoin
    Set RunJoinQuery = rsJoin
    'Stop
End Function

Private Sub ReadFromTextFile(ByVal oConnText As ADODB.Connection, ByVal sTableName As String)

    Dim rsText As ADODB.Recordset
    Set rsText = New ADODB.Recordset

    '*
    '* as with open for Excel I needed to use adOpenStatic
    '*
    rsText.Open "SELECT * From [" & sTableName & "]", oConnText, CursorTypeEnum.adOpenStatic '* can use CursorTypeEnum.adOpenKeyset
    Debug.Assert rsText.RecordCount > 0

    '*
    '* do some work with the recordset here
    '*
    DumpRecordset rsText
    'Stop

    Set rsText = Nothing
    'Stop

End Sub



Private Sub TestReadCatalogOfTextFile()
    ReadCatalogOfTextFile TextfilesDbFolder
End Sub

Private Sub ReadCatalogOfTextFile(ByVal sTextFile As String)
    Dim oConnText As ADODB.Connection
    Set oConnText = New ADODB.Connection
    oConnText.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & sTextFile & _
           ";Extended Properties='Text'"

    Dim catDB As ADOX.Catalog
    Dim tblList As ADOX.Table

    Set catDB = New ADOX.Catalog
    Set catDB.ActiveConnection = oConnText

    Dim adoxTables As ADOX.Tables
    Set adoxTables = catDB.Tables

    Dim adoxTableLoop As ADOX.Table
    For Each adoxTableLoop In adoxTables
        Debug.Print adoxTableLoop.name
    Next adoxTableLoop

End Sub

Private Sub DumpRecordset(ByVal rs As ADODB.Recordset)
    '*
    '* Some code to iterate over the recordset
    '*
    rs.MoveFirst

    Dim lFieldCount As Long
    lFieldCount = rs.Fields.Count

    While Not rs.EOF

        Dim sOutputLine As String
        sOutputLine = ""

        Dim sFieldAndValue As String
        Dim lFieldLoop As Long
        For lFieldLoop = 0 To lFieldCount - 1
            sFieldAndValue = rs.Fields.Item(lFieldLoop).name & ":" & rs.Fields.Item(lFieldLoop).Value

            sOutputLine = sOutputLine & VBA.IIf(Len(sOutputLine) > 0, vbTab, "") & sFieldAndValue
        Next
        Debug.Print sOutputLine
        rs.MoveNext
    Wend

End Sub

Private Sub UnitTestParseFileName()

    Const sTextFile As String = "N:Colors.txt"
    Dim sFileNameOnly As String, sFolderOnly As String

    Debug.Assert ParseFileName(sTextFile, sFileNameOnly, sFolderOnly)
    Debug.Assert sFileNameOnly = "Colors.txt"
    Debug.Assert sFolderOnly = "N:"

    Debug.Assert ParseFileName("N:folder1folder2Colors.txt", sFileNameOnly, sFolderOnly)
    Debug.Assert sFileNameOnly = "Colors.txt"
    Debug.Assert sFolderOnly = "N:folder1folder2"

End Sub

Private Function ParseFileName(ByVal sFullFileName As String, ByRef psFileNameOnly As String, ByRef psFolderOnly As String) As Boolean

    Dim vSplit As Variant
    vSplit = VBA.Split(sFullFileName, "")

    Dim lUBound As Long
    lUBound = UBound(vSplit)

    If lUBound > 0 Then
        psFileNameOnly = vSplit(lUBound)
        psFolderOnly = Left(sFullFileName, Len(sFullFileName) - Len(psFileNameOnly))
        ParseFileName = True
    End If

End Function

VBA - Microsoft.ACE.OLEDB.12.0 - Skip HTML Import Export

This post follows on from the other day's mega-post on Microsoft.ACE.OLEDB.12.0. As part of the investigation into the Excel engine, I discovered how to use the Html Export and Html Import drivers (yes they are separate).

Initially I was excited to find another way to store and retrieve data without requiring a database. After writing some code my enthusiasm has waned and my technical recommendation is that you skip this technology.

Weaknesses with the HTML Import Export Drivers

So, I ought to itemise my concerns here...

Type Inference

So the Excel driver has to sample some rows to guess the type of column (I have yet to find a way to declare the column type) and the Html Import driver does so equally. I came up against this more so with the Html Import driver, I'm guessing it samples fewer rows, anyway I had to change the text in the sample data (compared to the mega post) and give the hex values leading ampersands to enforce its inference as being a string. E.g. I needed to replace 00FF00 to &00FF00 in SetUpSomeData(). I have discovered that ordinary text files can have schema.ini files attached, which would put text files streets ahead of Html files because it obviates the need for type inference.

Html Export is not well-formed Xml

I'd like to nominate Html for a troublesome technology award. Html is in same family as Xml but typically cannot be parsed with Xml parsers because it is not well-formed. The latest version of Html, Html 5, is well-formed so going forward things ought to be better. This driver Microsoft.ACE.OLEDB.12.0 is quite new and ought to be output well-formed Html but it doesn't. This means having to write some large amounts of paring code (see AggregateHtmlFiles() in sample code). I could write that code ten times more concisely with Xml library!

Missed opportunity to export multiple tables to one single file

So I myself had to write code to aggregate tables to one single file. It turned out to be more painful that I imagined. The code below shows HTML parsing logic (see AggregateHtmlFiles() in sample code). If I were to rewrite this I'd scrap that approach and start with an Xml representation of cell block and XSLT transform that into the correct Html. This is a shame, for a while I thought multi-table Html file could make a nice config file.

Sample Code

Anyway, I wrote plenty of experimental code. Instead of throwing away this code, I will deposit here. There is an example of exporting from a sheet to an Html file. There is an example of reading an Html file.

Also, because the export only allows one table per Html file I have written some code to aggregate separate single table files into a multi-table file, see AggregateHtmlFiles(). I did this with the same libraries that Internet Explorer uses and so had to workaround IE bugs, code would have been much simple if the InsertAdjacentHTML method wasn't buggy.

Option Explicit
Option Private Module

'* Tools -> References
'* ADODB  Microsoft ActiveX Data Objects 6.1 Library  C:\Program Files (x86)\Common Files\System\ado\msado15.dll
'* ADOX   Microsoft ADO Ext. 6.0 for DDL and Security C:\Program Files (x86)\Common Files\System\ado\msadox.dll

Private Const msColorsHtmlFile As String = "N:Colors.html" '<---- change this to your working file location
Private Const msCurrenciesHtmlFile As String = "N:Currencies.html" '<---- change this to your working file location
Private Const msTeamsHtmlFile As String = "N:Teams.html" '<---- change this to your working file location
Private Const msAggregatedHtmlFile As String = "N:Aggregated.html" '<---- change this to your working file location

Private Sub SetUpSomeData()
    '* WARNING this will wipe data!
    Dim sht As Excel.Worksheet
    Set sht = ThisWorkbook.Worksheets.Item("Sheet1")
    sht.Cells.Clear

    '*
    '* use our array literal trick, for more tricks tips and 'blue sky thinking'
    '* see http://exceldevelopmentplatform.blogspot.com
    '*
    Dim vColors As Variant
    vColors = [{"Color","RGB";"Red","&FF0000";"Green","&00FF00"}] '* note the addition of the ampersand for type inference

    sht.Range("A1:B3").Value2 = vColors

    Dim vCurrencies As Variant
    vCurrencies = [{"Country","Ccy";"France","Euro";"Japan","Yen"}]

    sht.Range("D1:E3").Value2 = vCurrencies

    Dim vTeams As Variant
    vTeams = [{"Team","Country";"New York Red Bulls","US";"Spartak Moskva","Russia";"Man Utd","England";"Barcelona","Spain";"Bayern Munich","Germany"}]

    sht.Range("G1:H6").Value2 = vTeams

End Sub

Private Sub TestWriteToHtmlFile()
    WriteToHtmlFile ThisWorkbook.Worksheets.Item("Sheet1").Range("A1").CurrentRegion, msColorsHtmlFile
    WriteToHtmlFile ThisWorkbook.Worksheets.Item("Sheet1").Range("D1").CurrentRegion, msCurrenciesHtmlFile
    WriteToHtmlFile ThisWorkbook.Worksheets.Item("Sheet1").Range("G1").CurrentRegion, msTeamsHtmlFile
End Sub

Private Sub WriteToHtmlFile(ByVal rngTable As Excel.Range, ByVal sColorsHtmlFile As String)

    Dim sTableAddress As String
    sTableAddress = "[" & rngTable.Worksheet.Name & "$" & rngTable.Address(False, False, xlA1) & "] """

    Dim oConnExcel As ADODB.Connection
    Set oConnExcel = New ADODB.Connection

    If UBound(Split(ThisWorkbook.Name, ".")) = 0 Then Err.Raise vbObjectError, , "#Workbook needs a file extension, i.e. saved at least once!"

    '*
    '* we're reading from worksheet so we need the Excel engine
    '*
    oConnExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & ThisWorkbook.FullName & ";" & _
           "Extended Properties='Excel 12.0 Macro;HDR=YES'"

    Dim sFileNameOnly As String, sFolderOnly As String

    If ParseFileName(sColorsHtmlFile, sFileNameOnly, sFolderOnly) Then

        If Not Dir(sColorsHtmlFile) = "" Then Kill sColorsHtmlFile   '* if it exists then delete before re-exporting

        Dim sCmdText As String
        sCmdText = VBA.Replace("SELECT * INTO [%filename%] in %quotedFolder% ""HTML Export;"" FROM %tableName%", "%filename%", sFileNameOnly)
        sCmdText = VBA.Replace(sCmdText, "%quotedFolder%", """" & sFolderOnly & """")
        sCmdText = VBA.Replace(sCmdText, "%tableName%", sTableAddress)

        '*
        '* HTML Export is specified in the command text, no need for a separate connection
        '*
        Debug.Print sCmdText
        oConnExcel.Execute sCmdText
    End If

End Sub


Private Sub TestReadFromHtmlFile()
    ReadFromHtmlFile msColorsHtmlFile, "Colors"
    ReadFromHtmlFile msCurrenciesHtmlFile, "Currencies"
End Sub


Private Sub ReadFromHtmlFile(ByVal sHtmlFile As String, ByVal sTableName As String)

    Dim oConnHtmlImport As ADODB.Connection
    Set oConnHtmlImport = New ADODB.Connection
    oConnHtmlImport.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & sHtmlFile & _
           ";Extended Properties='HTML Import;HDR=YES'"

    Dim rsHtmlImport As ADODB.Recordset
    Set rsHtmlImport = New ADODB.Recordset

    '*
    '* the SQL-table-name is the same as the caption for the HTML table
    '* and not the HTML Title element as written in www.connectionstrings.com
    '*
    '* as with open for Excel I needed to use adOpenStatic
    '*
    rsHtmlImport.Open "SELECT * From [" & sTableName & "]", oConnHtmlImport, CursorTypeEnum.adOpenStatic '* can use CursorTypeEnum.adOpenKeyset
    Debug.Assert rsHtmlImport.RecordCount > 0

    '*
    '* do some work with the recordset here
    '*
    DumpRecordset rsHtmlImport
    'Stop

    '*
    '* when finished close the connection to stop file locks
    '*
    oConnHtmlImport.Close
    Set rsHtmlImport.ActiveConnection = Nothing
    Set oConnHtmlImport = Nothing
    Set rsHtmlImport = Nothing
    'Stop

End Sub

Private Sub TestAggregateHtmlFiles()
    Dim sTransactionFiles(0 To 1) As String
    sTransactionFiles(0) = msCurrenciesHtmlFile
    sTransactionFiles(1) = msTeamsHtmlFile
    
    
    Dim sNewMasterHtml As String
    sNewMasterHtml = AggregateHtmlFiles(msColorsHtmlFile, sTransactionFiles)
    Debug.Print sNewMasterHtml
    
    Dim lFile As Long
    lFile = FreeFile()

    If Dir(msAggregatedHtmlFile) <> "" Then Kill msAggregatedHtmlFile

    Open msAggregatedHtmlFile For Output As #lFile
    Print #lFile, sNewMasterHtml
    Close #lFile
    
End Sub

Private Function AggregateHtmlFiles(ByVal sMasterFile As String, ByRef sTransactionFiles() As String) As String
    '*
    '* check files exists firstly
    '*
    CheckHtmlFileExists sMasterFile
    Dim lTransactionFileLoop As Long
    For lTransactionFileLoop = LBound(sTransactionFiles) To UBound(sTransactionFiles)
        Dim sTransactionFile As String
        sTransactionFile = sTransactionFiles(lTransactionFileLoop)

        CheckHtmlFileExists sTransactionFile
    Next

    Dim oHtml4 As MSHTML.IHTMLDocument4
    Set oHtml4 = New MSHTML.HTMLDocument

    Dim htmlMaster As MSHTML.HTMLDocument
    Set htmlMaster = oHtml4.createDocumentFromUrl(sMasterFile, "")



    While htmlMaster.readyState <> "complete": DoEvents: Wend
    Dim objMasterTable As HTMLTable, objMasterTableList As Object
    Set objMasterTableList = htmlMaster.querySelectorAll("table > caption")
    Set objMasterTable = objMasterTableList.Item(objMasterTableList.Length - 1).parentElement
    'objMasterTable.parentElement

    Dim oMasterBody As MSHTML.HTMLBody
    Set oMasterBody = objMasterTable.parentElement

    For lTransactionFileLoop = LBound(sTransactionFiles) To UBound(sTransactionFiles)

        sTransactionFile = sTransactionFiles(lTransactionFileLoop)

        '*
        Dim htmlTransactionFile As MSHTML.HTMLDocument
        Set htmlTransactionFile = oHtml4.createDocumentFromUrl(sTransactionFile, "")
        While htmlTransactionFile.readyState <> "complete": DoEvents: Wend

        '* get captioned table
        Dim objTransactionTableCaption As HTMLTable
        Set objTransactionTableCaption = htmlTransactionFile.querySelector("table > caption")


        If Not objTransactionTableCaption Is Nothing Then
            '*
            Dim objTransactionTable As HTMLTable
            Set objTransactionTable = objTransactionTableCaption.parentElement


            '* write and add the table element
            Dim objNewTable As HTMLTable
            Set objNewTable = htmlMaster.createElement("TABLE")
            objNewTable.setAttribute "border", "1"
            oMasterBody.appendChild objNewTable


            '* write and add the table caption element
            Dim objNewCaption As HTMLTableCaption
            Set objNewCaption = htmlMaster.createElement("CAPTION")
            objNewTable.appendChild objNewCaption
            objNewCaption.innerText = objTransactionTableCaption.innerText

            '* write the column headers
            Dim objTransTableHeaderRow As Object
            Set objTransTableHeaderRow = objTransactionTable.querySelectorAll("tr > th").Item(0).parentElement

            Dim objNewTableRow As Object
            Set objNewTableRow = htmlMaster.createElement("TR")
            objNewTable.appendChild objNewTableRow

            Dim lColumnCount As Long, lColumnLoop As Long
            lColumnCount = objTransTableHeaderRow.ChildNodes.Length

            For lColumnLoop = 0 To lColumnCount - 1
                Dim objNewTH As Object, objTransTH As Object
                Set objTransTH = objTransTableHeaderRow.ChildNodes.Item(lColumnLoop)
                Set objNewTH = htmlMaster.createElement("TH")
                objNewTH.innerText = objTransTH.innerText
                objNewTableRow.appendChild objNewTH
            Next

            Dim objTransTableDataRow As Object
            Set objTransTableDataRow = objTransTableHeaderRow.NextSibling
            While Not objTransTableDataRow Is Nothing
                
                Set objNewTableRow = htmlMaster.createElement("TR")
                objNewTable.appendChild objNewTableRow
                
                For lColumnLoop = 0 To lColumnCount - 1
                    Dim objNewTD As Object, objTransTD As Object
                    Set objTransTD = objTransTableDataRow.ChildNodes.Item(lColumnLoop)
                    Set objNewTD = htmlMaster.createElement("TD")
                    objNewTD.innerText = objTransTD.innerText
                    objNewTableRow.appendChild objNewTD
                Next

                Set objTransTableDataRow = objTransTableDataRow.NextSibling
            Wend

        End If

    Next lTransactionFileLoop

    AggregateHtmlFiles = htmlMaster.DocumentElement.outerHTML

End Function

Private Sub CheckHtmlFileExists(ByVal sHtmlFile As String)
    If Dir(sHtmlFile) = "" Then Err.Raise vbObjectError, , "#File '" & sHtmlFile & "' does not exist!"
End Sub

Private Sub TestReadCatalogOfHtmlFile()
    ReadCatalogOfHtmlFile msColorsHtmlFile
    ReadCatalogOfHtmlFile msCurrenciesHtmlFile
End Sub

Private Sub ReadCatalogOfHtmlFile(ByVal sColorsHtmlFile As String)
    Dim oConnHtmlImport As ADODB.Connection
    Set oConnHtmlImport = New ADODB.Connection
    oConnHtmlImport.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & sColorsHtmlFile & _
           ";Extended Properties='HTML Import;HDR=YES'"

    Dim catDB As ADOX.Catalog
    Dim tblList As ADOX.Table

    Set catDB = New ADOX.Catalog
    Set catDB.ActiveConnection = oConnHtmlImport

    Dim adoxTables As ADOX.Tables
    Set adoxTables = catDB.Tables

    Dim adoxTableLoop As ADOX.Table
    For Each adoxTableLoop In adoxTables
        Debug.Print adoxTableLoop.Name
    Next adoxTableLoop

End Sub

Private Sub DumpRecordset(ByVal rs As ADODB.Recordset)
    '*
    '* Some code to iterate over the recordset
    '*
    rs.MoveFirst

    Dim lFieldCount As Long
    lFieldCount = rs.Fields.Count

    While Not rs.EOF

        Dim sOutputLine As String
        sOutputLine = ""

        Dim sFieldAndValue As String
        Dim lFieldLoop As Long
        For lFieldLoop = 0 To lFieldCount - 1
            sFieldAndValue = rs.Fields.Item(lFieldLoop).Name & ":" & rs.Fields.Item(lFieldLoop).Value

            sOutputLine = sOutputLine & VBA.IIf(Len(sOutputLine) > 0, vbTab, "") & sFieldAndValue
        Next
        Debug.Print sOutputLine
        rs.MoveNext
    Wend

End Sub

Private Sub UnitTestParseFileName()

    Const sExportFile As String = "N:Colors.html"
    Dim sFileNameOnly As String, sFolderOnly As String

    Debug.Assert ParseFileName(sExportFile, sFileNameOnly, sFolderOnly)
    Debug.Assert sFileNameOnly = "Colors.html"
    Debug.Assert sFolderOnly = "N:"

    Debug.Assert ParseFileName("N:folder1folder2Colors.html", sFileNameOnly, sFolderOnly)
    Debug.Assert sFileNameOnly = "Colors.html"
    Debug.Assert sFolderOnly = "N:folder1folder2"

End Sub

Private Function ParseFileName(ByVal sFullFileName As String, ByRef psFileNameOnly As String, ByRef psFolderOnly As String) As Boolean

    Dim vSplit As Variant
    vSplit = VBA.Split(sFullFileName, "")

    Dim lUBound As Long
    lUBound = UBound(vSplit)

    If lUBound > 0 Then
        psFileNameOnly = vSplit(lUBound)
        psFolderOnly = Left(sFullFileName, Len(sFullFileName) - Len(psFileNameOnly))
        ParseFileName = True
    End If

End Function

Sample Output

Sample Export Html Source

<HTML DIR=LTR>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=Windows-1252">
<TITLE>Colors</TITLE>
</HEAD>
<BODY>
<TABLE DIR=LTR BORDER>
<CAPTION>Colors</CAPTION>
<TR>
<TH>Color</TH>
<TH>RGB</TH>
</TR>
<TD DIR=LTR ALIGN=LEFT>Red</TD>
<TD DIR=LTR ALIGN=LEFT>FF0000</TD>
</TR>
<TR>
<TD DIR=LTR ALIGN=LEFT>Green</TD>
<TD DIR=LTR ALIGN=LEFT>00FF00</TD>
</TR>
</TABLE>
</BODY>
</HTML>

Sample Export Html Rendered

Colors
Color RGB
Red FF0000
Green 00FF00

Sample Export of Multiple Tables Html Source

<HTML DIR=LTR>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=Windows-1252">
<TITLE>cannot be empty</TITLE>
</HEAD>
<BODY>

<TABLE>
<TR><TD>

<TABLE DIR=LTR BORDER>
<CAPTION>Colors</CAPTION>
<TR>
<TH>Color</TH>
<TH>RGB</TH>
</TR>
<TD DIR=LTR ALIGN=LEFT>Red</TD>
<TD DIR=LTR ALIGN=LEFT>&FF0000</TD>
</TR>
<TR>
<TD DIR=LTR ALIGN=LEFT>Green</TD>
<TD DIR=LTR ALIGN=LEFT>&00FF00</TD>
</TR>
</TABLE>

</TD><TD>

<TABLE DIR=LTR BORDER>
<CAPTION>Currencies</CAPTION>
<TR>
<TH>Country</TH>
<TH>Ccy</TH>
</TR>
<TD DIR=LTR ALIGN=LEFT>France</TD>
<TD DIR=LTR ALIGN=LEFT>Euro</TD>
</TR>
<TR>
<TD DIR=LTR ALIGN=LEFT>Japan</TD>
<TD DIR=LTR ALIGN=LEFT>Yen</TD>
</TR>
</TABLE>
</TR>
</TABLE>
</BODY>
</HTML>

Sample Export of Multiple Tables Html Rendered

Colors
Color RGB
Red &FF0000
Green &00FF00
Currencies
Country Ccy
France Euro
Japan Yen

Tuesday, 9 October 2018

VBA - Microsoft.ACE.OLEDB.12.0 details

I investigated Microsoft.ACE.OLEDB.12.0 and have plenty of artefacts and findings. In case you haven't met this component it allows data to be read and written to Excel worksheets using SQL technology.

Nomenclature

As far as I can see ACE stands for Access Connectivity Engine. This wikipedia article is a good web page which highlights the history of the name.

COM Registry entries

Some time back (with some help from StackOverflow) I got the ATL C++ Sample OLEDB Provider compiled and working. From that experience I can tell you that every provider string is in fact a COM Prog ID. This means we call write code like this to test the installation...

Private Sub TestInstallation()
    Dim iunkOleDb As IUnknown
    Set iunkOleDb = VBA.CreateObject("Microsoft.ACE.OLEDB.12.0")  '<--- this would error if not installed
End Sub

It also means if we scan the registry for the Prog ID "Microsoft.ACE.OLEDB.12.0" then we can find other details. I have placed a registry export of the COM registry entries in Appendix A.

From the details it can be seen that the ProgId is 'Microsoft.ACE.OLEDB.12.0' whilst the fuller name is 'Microsoft Office 12.0 Access Database Engine OLE DB Provider' and it is implemented in the executable ACEOLEDB.DLL. This gives us some search terms to google on.

Installation

If you need to install this then you must download the Microsoft Access Database Engine 2010 Redistributable . The accompanying explanatory text says this is not a replacement for Jet saying one should use SQL Server Express Edition but to be honest I think many of us do see Microsoft.ACE.OLEDB.12.0 as a Jet replacement.

Also on that download page there some help about how to use an Extended Property in the connection string to specify the correct file format version.

File Type (extension)                               Extended Properties
---------------------------------------------------------------------------------------------
Excel 97-2003 Workbook (.xls)                       "Excel 8.0"
Excel 2007-2010 Workbook (.xlsx)                    "Excel 12.0 Xml"
Excel 2007-2010 Macro-enabled workbook (.xlsm)      "Excel 12.0 Macro"
Excel 2007-2010 Non-XML binary workbook (.xlsb)     "Excel 12.0"

As it turns out, one can supply a wider range of values than those shown above, i.e. non-Excel file formats. Appendix D shows a screenshot of the registry which I believe shows all the valid values, they are all ISAM Formats.

Pitfall - Workbooks needs to be saved

I suspect the code in the provider is contingent on the workbook's file extension and it will complain if it has no file extension. When you create a workbook, it is just "Book1" ; it has no file extension until it has been saved at least once. This pitfall is easily countered with a line of defensive code to inspect the workbook's file extension ...

    Debug.Assert UBound(Split(ThisWorkbook.Name, ".")) > 0  '* Workbook needs a file extension, i.e. saved at least once!

... or ...

    If UBound(Split(ThisWorkbook.Name, ".")) = 0 Then Err.Raise vbObjectError, , "#Workbook needs a file extension, i.e. saved at least once!"

Connection Strings Resources

An excellent resource for how to build a connection string for any data provider is www.connectionstrings.com and on that link one can see connection strings for historic versions of Excel. Also on that page are details of extended properties.

Jet Extended Properties

I'd like to compile a list of extended properties that relate to Microsoft.ACE.OLEDB.12.0 . I suspect many of them are inherited from the Jet. So here is a list of Jet extended properties courtesy of Working with MS Excel(xls / xlsx) Using MDAC and Oledb - CodeProject, a great article that I won't try and replicate.

Looks like Extended Properties needs enclosing double quotes (in some cases at least).

  • HDR - Short for Header, if YES then the top row are like column headers and interpreted as field names.
  • ReadOnly
  • FirstRowHasNames - different way to do same as HDR
  • MaxScanRows - data types are inferred from n rows, this sets n
  • IMEX - I'm guessing this is short for Import/Export and is also used in column type inference

Related to IMEX is ImportMixedTypes which I have seen in an Microsoft.ACE.OLEDB.12.0 connection string but not in a Jet connection string. For Jet and Microsoft.ACE.OLEDB.12.0 ImportMixedTypes is a registry entry but it also looks like supplying ImportMixedTypes in the Microsoft.ACE.OLEDB.12.0 connection string allows an override. For explanation of ImportMixedTypes here is another great article, this time at dailydoseofexcel.com, Daily Dose of Excel - External Data – Mixed Data Types .

Pitfall - The Problem of Type Inference

So the OLEDB Provider infers a column's data type from its contents, sampling the data. I don't much like this, I'd prefer a way to specify the data type but I have yet to find a way to do this. Perhaps it is best to ensure the data in the cells is consistent, we can lock sheets and control access to ensure a user does not corrupt the data but then that creates a need to show a separate data entry form. I will mull this. In the meantime I'd advise you are very disciplined that any data you write is type consistent for that column.

Access Connectivity Engine

So I have discovered another bunch of registry entries which I placed in Appendix B. So there is another dll at work here, ACEEXCL.DLL. I will try to investigate how ACEEXCL.DLL interacts with ACEOLEDB.DLL. UPDATE: I solved this in Appendix D!

Pitfall - Pass CursorTypeEnum.adOpenKeyset or CursorTypeEnum.adOpenStatic When Opening a Recordset

Even after correctly forming a connection strings I have still had some issues using this OLEDB provider. So in in my use case when calling the Recordset.Open method it is critical to pass the right enumeration value. CursorTypeEnum.adOpenDynamic and CursorTypeEnum.adOpenForwardOnly did not throw errors they simply returned an empty recordset! This matters because I believe one of them is the assumed default. I needed to pass either CursorTypeEnum.adOpenKeyset or CursorTypeEnum.adOpenStatic to get any rows back.

Pitfall - Better To Specify an Exact Range Than a Whole Sheet

Even after sorting a connection string and CursorTypeEnum parameter one can still get bugs. If a whole sheet is specified then it will infer data from the whole Worksheet.UsedRange. This means if you dirty your cells on the sheet (by entering anything and deleting them) then that cell and all those between it and $A$1 will be implied to belong to the table. So it is better to find the range with [A1].CurrentRegion.Address and either (1) define a name over that range and pass range name into the SQL or (2) used the explicit address of the range, e.g. $A$1:$B$3

Sample Code to Open a Recordset

So now we know where the pitfalls lie we can write some defensive sample code. This code opens a recordset and prints out its contents. PLEASE USE A FRESH NEW WORKBOOK! There is some setup code to write some data to a sheet in SetUpSomeData() so best to use a new workbook but remember to save the workbook at least once.

The code demonstrates the following points ...

  • It defends against the pitfalls of unsaved workbooks;
  • it supplies a working CursorTypeEnum;
  • it restricts the cells to select, by two different methods (1) by name and (2) by cell address

As a bonus I have added some code in ReadExcelCatalog which demonstrates using the ADOX library to read schema information so one can tell exactly what the OLEDB provider is inferring for a column type. Enjoy!.

Option Explicit
Option Private Module

'* Tools -> References
'* ADODB  Microsoft ActiveX Data Objects 6.1 Library  C:\Program Files (x86)\Common Files\System\ado\msado15.dll
'* ADOX   Microsoft ADO Ext. 6.0 for DDL and Security C:\Program Files (x86)\Common Files\System\ado\msadox.dll

Private Sub SetUpSomeData()
    '* WARNING this will wipe data!
    Dim sht As Excel.Worksheet
    Set sht = ThisWorkbook.Worksheets.Item("Sheet1")
    sht.Cells.Clear
    
    '*
    '* use our array literal trick, for more tricks tips and 'blue sky thinking'
    '* see http://exceldevelopmentplatform.blogspot.com
    '*
    Dim vData As Variant
    vData = [{"Color","RGB";"Red","FF0000";"Green","00FF00"}]

    sht.Range("A1:B3").Value2 = vData

End Sub

Private Sub TestInstallation()

    Dim iunkOleDb As IUnknown
    Set iunkOleDb = VBA.CreateObject("Microsoft.ACE.OLEDB.12.0")  '<--- this would error if not installed

End Sub


Private Sub ReadData()
    '* Code here assumes there is data in top left of Sheet1, call SetUpSomeData() first if you have no data
    'Call SetUpSomeData

    Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    
    If UBound(Split(ThisWorkbook.Name, ".")) = 0 Then Err.Raise vbObjectError, , "#Workbook needs a file extension, i.e. saved at least once!"
    
    'Debug.Assert UBound(Split(ThisWorkbook.Name, ".")) > 0  '* Workbook needs a file extension, i.e. saved at least once!
    
    oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & ThisWorkbook.FullName & ";" & _
           "Extended Properties='Excel 12.0 Macro;HDR=YES'"
           
    
    Dim sht As Excel.Worksheet
    Set sht = ThisWorkbook.Worksheets.Item("Sheet1")
    
    
    '*
    '* Limit the range to the block of cells contigous with A1
    '*
    Dim rngTable As Excel.Range
    Set rngTable = sht.Cells(1, 1).CurrentRegion
    
    
    '*
    '* Case 1 - using Named Range
    '* (use separate recordset)
    '*
    Dim rsByName As ADODB.Recordset
    Set rsByName = New ADODB.Recordset
    
    ThisWorkbook.Names.Add "MyTable", rngTable
    
    Dim sCmdTextUsingName As String
    sCmdTextUsingName = "Select * From MyTable"
    
    rsByName.Open sCmdTextUsingName, oConn, CursorTypeEnum.adOpenStatic '* can use CursorTypeEnum.adOpenKeyset
    Debug.Assert rsByName.RecordCount > 0
    
    
    
    '*
    '* Case 2 - using Cell Addresses
    '* (use separate recordset)
    '*
    Dim rsByCellAddress As ADODB.Recordset
    Set rsByCellAddress = New ADODB.Recordset
    
    Dim sCmdTextUsingCellAddress As String
    sCmdTextUsingCellAddress = "Select * From [" & sht.Name & "$" & rngTable.Address(False, False, xlA1) & "]"
    
    rsByCellAddress.Open sCmdTextUsingCellAddress, oConn, CursorTypeEnum.adOpenStatic '* can use CursorTypeEnum.adOpenKeyset
    Debug.Assert rsByCellAddress.RecordCount > 0
    

    '*
    '* output one of the recordsets (they should be identical)
    '*
    DumpRecordset rsByCellAddress

End Sub

Private Sub DumpRecordset(ByVal rs As ADODB.Recordset)
    '*
    '* Some code to iterate over the recordset
    '*
    rs.MoveFirst
    
    Dim lFieldCount As Long
    lFieldCount = rs.Fields.Count
    
    While Not rs.EOF
            
        Dim sOutputLine As String
        sOutputLine = ""
            
        Dim sFieldAndValue As String
        Dim lFieldLoop As Long
        For lFieldLoop = 0 To lFieldCount - 1
            sFieldAndValue = rs.Fields.Item(lFieldLoop).Name & ":" & rs.Fields.Item(lFieldLoop).Value
            
            sOutputLine = sOutputLine & VBA.IIf(Len(sOutputLine) > 0, vbTab, "") & sFieldAndValue
        Next
        Debug.Print sOutputLine
        rs.MoveNext
    Wend

End Sub


Private Sub ReadExcelCatalog()
    '*
    '* Some code to give the schema details such as columns names and columns types (what is inferred rathe than what is defined)
    '*
    Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    
    If UBound(Split(ThisWorkbook.Name, ".")) = 0 Then Err.Raise vbObjectError, , "#Workbook needs a file extension, i.e. saved at least once!"
    
    'Debug.Assert UBound(Split(ThisWorkbook.Name, ".")) > 0  '* Workbook needs a file extension, i.e. saved at least once!
    
    oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & ThisWorkbook.FullName & ";" & _
           "Extended Properties='Excel 12.0 Macro;HDR=YES'"
    
    Dim catDB As ADOX.Catalog
    Set catDB = New ADOX.Catalog
    Set catDB.ActiveConnection = oConn
    
    Dim adoxTableLoop As ADOX.Table
    For Each adoxTableLoop In catDB.Tables
        If adoxTableLoop.Name = "MyTable" Then
            Dim adoxColumnLoop As ADOX.Column
            For Each adoxColumnLoop In adoxTableLoop.Columns
                Debug.Print adoxColumnLoop.Name & vbTab & Switch(adoxColumnLoop.Type = adVarWChar, "String", adoxColumnLoop.Type = adDouble, "Double")
            Next
        End If
    Next

End Sub

Links

Appendix A - COM Registry entries

It always useful to poke around in the registry to see what makes something tick, here is a registry export of the related keys. It turns out there is a second bunch of registry keys to tune the behaviour (page down). The following set of registry keys fulfil the COM registration requirements for OLEDB providers.

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Classes\Wow6432Node\
CLSID\{3BE786A0-0366-4F5C-9434-25CF162E475E}]
"OLEDB_SERVICES"=dword:fffffffe
@="Microsoft.ACE.OLEDB.12.0"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Classes\Wow6432Node\
CLSID\{3BE786A0-0366-4F5C-9434-25CF162E475E}\ExtendedErrors]
@="Microsoft.ACE.OLEDBErrors.12.0"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Classes\Wow6432Node\
CLSID\{3BE786A0-0366-4F5C-9434-25CF162E475E}\ExtendedErrors\{3BE786A0-0366-4F5C-9434-25CF162E475F}]
@="Microsoft.ACE.OLEDBErrors.12.0"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Classes\Wow6432Node\
CLSID\{3BE786A0-0366-4F5C-9434-25CF162E475E}\InprocServer32]
@="C:\\Program Files (x86)\\Common Files\\Microsoft Shared\\OFFICE15\\ACEOLEDB.DLL"
"ThreadingModel"="Both"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Classes\Wow6432Node\
CLSID\{3BE786A0-0366-4F5C-9434-25CF162E475E}\OLE DB Provider]
@="Microsoft Office 12.0 Access Database Engine OLE DB Provider"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Classes\Wow6432Node\
CLSID\{3BE786A0-0366-4F5C-9434-25CF162E475E}\ProgID]
@="Microsoft.ACE.OLEDB.12.0"

Appendix B - Access Connectivity Engine Registry entries

So I have discovered another bunch of registry entries which I found after discovering this page Initializing the Microsoft Excel Driver -MSDN.

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\
Microsoft\Office\15.0\Access Connectivity Engine\Engines\Excel]
"DisabledExtensions"="!xls"
"ImportMixedTypes"="Text"
"FirstRowHasNames"=hex:01
"AppendBlankRows"=dword:00000001
"TypeGuessRows"=dword:00000008
"win32"="C:\\Program Files (x86)\\Common Files\\Microsoft Shared\\OFFICE15\\ACEEXCL.DLL"

Appendix C - Access Connectivity Engine Files and Dependencies

So there is a whole bunch of files prefixed with ACE*.DLL which look related to Access Connectivity Engine, for me they are located in

C:\Program Files\Microsoft Office 15\root\vfs\ProgramFilesCommonX86\Microsoft Shared\OFFICE15

which looks like some sort of virtualised file system (is that what the vfs stands for?). Anyway, here is the list

 Directory of C:\Program Files\Microsoft Office 15\root\vfs\ProgramFilesCommonX86\Microsoft Shared\OFFICE15

1,680,128 ACECORE.DLL   'depends on OS files OLE32.DLL, ADVAPI32.DLL, KERNEL32.DLL, OLEAUT32.DLL and C++ Files MSVCR100.DLL and MSVCP100.DLL
  432,384 ACEDAO.DLL    'depends on OS files OLE32.DLL, ADVAPI32.DLL, KERNEL32.DLL, OLEAUT32.DLL and C++ Files MSVCR100.DLL 
   35,032 ACEERR.DLL    'depends on OS files OLE32.DLL, ADVAPI32.DLL, KERNEL32.DLL               and C++ Files MSVCR100.DLL 
  633,688 ACEES.DLL     'depends on OS files OLE32.. ADVAPI32.. KERNEL32.. OLEAUT32.. VERSION.DLL and MSVCR100.. MSVCP100..
  186,600 ACEEXCH.DLL   'depends on ACECORE.DLL ; OS files OLE32.. ADVAPI32.. KERNEL32.. OLEAUT32..  and MSVCR100.. 
  400,184 ACEEXCL.DLL   'depends on ACECORE.DLL ; OS files OLE32.. ADVAPI32.. KERNEL32.. OLEAUT32..  and MSVCR100..  MSVCP100..
  278,256 ACEODBC.DLL   'depends OS files GDI32.DLL OLE32.. ADVAPI32.. KERNEL32.. COMDLG32.DLL  and MSVCR100..  
   15,000 ACEODEXL.DLL  'depends on ACEODBC.DLL ; OS file KERNEL32..  and MSVCR100..  
   15,016 ACEODTXT.DLL  'depends on ACEODBC.DLL ; OS file KERNEL32..  and MSVCR100..  
  329,552 ACEOLEDB.DLL  'depends on OS files OLE32.DLL, ADVAPI32.DLL, KERNEL32.DLL, OLEAUT32.DLL and C++ Files MSVCR100.DLL 
  161,400 ACETXT.DLL    'depends on ACECORE.DLL ; OS files OLE32.. ADVAPI32.. KERNEL32.. OLEAUT32..  and C++ MSVCR100..  MSVCP100..
3,049,184 ACEWDAT.DLL   'depends on OS file KERNEL32.DLL and C++ File MSVCR100.DLL 

I do not know what ACEES.DLL or ACEWDAT.DLL are but all the other files we can guess at their purpose.

ACECORE.DLL   'The core library for Access Connectivity Engine (ACE)
ACEDAO.DLL    'The DAO (Data Access Objects) companion file for ACE
ACEERR.DLL    '?A repository of error messages?
ACEEXCH.DLL   'The Microsoft Exchange companion/driver file for ACE
ACEEXCL.DLL   'The Microsoft Excel companion/driver file for ACE via OLEDB
ACEODBC.DLL   'The ODBC (Open Database Connectivity) companion file for ACE
ACEODEXL.DLL  'The Microsoft Excel companion/driver file for ACE via ODBC
ACEODTXT.DLL  'The Textfile companion/driver file for ACE via ODBC
ACEOLEDB.DLL  'The core OLEDB ACE file
ACETXT.DLL    'The Textfile companion/driver file for ACE via OLEDB

We know the route into the code starts with COM and ACEOLEDB.DLL (see Appendix A), looking at the entry points for ACEOLEDB.DLL we see the classic COM entry points

DllCanUnloadNow
DllGetClassObject
DllMain

If we look at the entry point for ACEEXCL.DLL we see the classic COM entry points

DllGetClassObject

so very much a COM DLL. I wonder what classes are created and passed out by these DLLs. OLEVIEW sheds no light on this or ACEOLEDB.DLL

Appendix D - ISAM Formats (first term of Extended Properties) Map to Engines

Below is a screenshot of the registry which I believe shows all the valid values for the first term of the Extended Properties. They are all ISAM Formats.

Looking down the list of Value Data pairs for the given key, 'Excel 12.0 Macro', we can see one entry 'Engine' with 'Excel' as the string data. The 'HTML Export' and 'HTML Import' keys also have 'Engine' Values with 'Text' as the string data. In another screenshot we can see that they must be mapping to the keys under the Engines key. I have drawn some mapping lines (sorry no arrow heads).

Let's look at what is the Excel engine key. Voila, it tells which DLL to load to handle requests for Excel in the win32 value ...ACEEXCL.DLL . The Value-Data pairs shown below in the next screenshot have already been detailed in Appendix B but it is only now that I have pieced together the logic sequence to the load the right 'engine' file.