Ole-DB Excel Client is an experimental cockpit to query data via OLE DB into an Excel sheet.
option explicit
sub create(xlsName as variant) ' {
with sheet1 ' {
.name = "Cockpit"
.cells(2,2) = "Provider" : .cells(2,3).name = "oleDbProv" : range("oleDbProv" ) = "Microsoft.ACE.OLEDB.12.0"
.cells(3,2) = "Data Source" : .cells(3,3).name = "oleDbDataSrc" : range("oleDbDataSrc" ) = xlsName
.cells(4,2) = "Extended Properties" : .cells(4,3).name = "oleDbExtProps" : range("oleDbExtProps") = "Excel 12.0 Xml;HDR=YES;IMEX=1"
.columns(2).autoFit
with addTextBox(.range(.cells(6, 2), .cells(18, 26)), "sqlText") ' {
.font = "Courier New"
.enterKeyBehavior = true
.multiLine = true
.borderStyle = fmBorderStyleSingle
.backColor = rgb(255, 250, 200)
end with ' }
with addButton(.range(.cells(20,2), .cells(21,3)), "btn", "Run SQL") ' {
end with ' }
end with ' }
end sub ' }
sub processQuery() ' {
dim sht as workSheet
set sht = worksheets.add
dim dataSource as string
dataSource = sheet1.range("oleDbDataSrc")
if dir(dataSource) = "" then ' {
msgBox "Data source not found:" & vbCrLf & dataSource
exit sub
end if ' }
dim source as string
source = "OLEDB;provider=" & sheet1.range("oleDbProv") & ";data source=" & dataSource
if sheet1.range("oleDbExtProps") <> "" then
source = source & ";Extended Properties='" & sheet1.range("oleDbExtProps") & "'"
end if
insertListObject _
source := source , _
sqlStatement := sheet1.sqlText , _
destCell := sht.cells(3,1)
end sub ' }
sub insertListObject( source as string, sqlStatement as string, destCell as range) ' {
on error goto err_
dim listObj as listObject
set listObj = activeSheet.listObjects.add( _
sourceType := xlSrcExternal , _
source := array(source) , _
destination := destCell)
with listObj ' {
.displayName = "Data_from_other_worksheet" ' Must not contain white spaces
with .queryTable ' {
' .adjustColumnWidth = true ' True is default anyway
.commandType = xlCmdSql
.commandText = array(sqlStatement)
' .rowNumbers = false
.refreshOnFileOpen = false ' Get newest data when worksheet is opened (Default is false)
.backgroundQuery = true ' Update data asynchronously
.refreshStyle = xlInsertDeleteCells ' Partial rows are inserted or deleted to match the exact number of rows required for the new recordset.
.saveData = true
.refreshPeriod = 0 ' Refresh period in minuts. 0 disables refreshing.
.preserveColumnInfo = true ' Preserve sorting, filtering, and layout information when data is refreshed.
.refresh backgroundQuery := false ' Refresh the data NOW.
end with ' }
end with ' }
exit sub
err_:
msgBox err.number & chr(10) & err.description
end sub ' }
sub createSourceWorksheet(fileName as string) ' {
'
' Delete source workbook file if it alread exists.
'
if dir(fileName) <> "" then ' {
kill fileName
end if ' }
dim otherWorkbook as workbook
set otherWorkbook = workbooks.add
with otherWorkbook ' {
dim firstCell as range
with .sheets(1) ' {
dim r as long : r = 3
set firstCell = .cells(r,2)
.range( .cells(r, 2), .cells(r, 4) ).value = array("Col one", "Col two", "Col three" ) : r = r + 1
.range( .cells(r, 2), .cells(r, 4) ).value = array("Baz" , 42 , #2020-03-03# ) : r = r + 1
.range( .cells(r, 2), .cells(r, 4) ).value = array("Bar" , 99 , #2018-05-17# ) : r = r + 1
.range( .cells(r, 2), .cells(r, 4) ).value = array("Baz" , 123456 , #2019-11-13# ) : r = r + 1
.range( .cells(r, 2), .cells(r, 4) ).value = array("Foo" , 518 , #2018-07-19# ) : r = r + 1
.range( .cells(r, 2), .cells(r, 4) ).value = array("Baz" , 219 , #2014-10-02# ) : r = r + 1
.range( .cells(r, 2), .cells(r, 4) ).value = array("Foo" , 21 , #2015-09-09# )
'
' Name a source data range
'
.range( firstCell, .cells(r,4) ).name = "srcTable"
.usedRange.columns.autoFit
end with ' }
.saveAs _
fileName := fileName, _
fileFormat := xlOpenXMLWorkbook
.close
end with ' }
end sub ' }
option explicit
private sub sqlText_keyDown(byVal keyCode as msForms.returnInteger, byVal state as integer) ' {
' dim shift, alt, ctrl as string
' if state and 1 then shift = "shf"
' if state and 2 then ctrl = "ctl"
' if state and 4 then alt = "alt"
if (state and 2) and (keyCode = 13) then ' {
processQuery
end if ' }
end sub ' }
private sub btn_click() ' {
processQuery
end sub ' }
option explicit
function addTextBox(rng as range, name as string) as msForms.textBox ' {
set addTextBox = addOleObject("Forms.TextBox.1", rng).object
addTextBox.name = name
end function ' }
function addButton(rng as range, name as string, caption as string) as msForms.commandButton ' {
set addButton = addOleObject("Forms.CommandBUtton.1", rng).object
addButton.name = name
addButton.caption = caption
end function ' }
function addOleObject(classType as string, rng as range) as oleObject ' {
set addOleObject = rng.parent.OLEObjects.add( _
classType := classType , _
link := false , _
displayAsIcon := false , _
left := rng.left , _
top := rng.top , _
width := rng.width , _
height := rng.height _
)
end function ' }
create.wsf is the script that can be executed on the command line (using cscript.exe) to create the OleDb Excel Client. This script requires the VBS Office Application Creator.
<job>
<script language="VBScript" src="VBS-MS-Office-App-Creator/create-MS-Office-app.vbs" />
<script language="VBScript">
option explicit
dim app
dim xls
dim xlsName
xlsName = currentDir() & "Excel-OleDb-Client.xlsm"
set xls = createOfficeApp("excel", xlsName)
if xls is nothing then ' {
wscript.echo("Could not create excel worksheet.")
wscript.quit(-1)
end if ' }
set app = xls.application
' Microsoft Forms 2.0 Object Library:
addReference app, "{0D452EE1-E08F-101A-852E-02608C4D0BB4}", 2, 0
insertModule app, currentDir() & "functionality.vb", "funcs" , 1
insertModule app, currentDir() & "addTextBox.vb" , "addTextBox_" , 1
insertModule app, currentDir() & "sheet1.vb" , xls.sheets(1).codeName, 1
app.run "create", xlsName
compileApp app
xls.save
wscript.echo "The end"
createObject("WScript.Shell").appActivate app.caption
</script> </job>