VB6: Down the memories line – Automation of MS Excel

By | 2017-02-11

When I wrote the article about B4J and MS Excel I got a stronger feeling on publishing the report solutions based on Classic VB (VB6).  Here it is and I’m happy to share it with You. Despite all the great new developing tools outhere I still prefer to use Classic. Why? Because it’s still an excellent RAD-Tool.

The following code is used to pump data from a SQLite databases into a MS Excel’s prepared template file. Actually, it’s the same case as published in the previously article about B4J and MS Excel. I intentionally left the code without comments. Why? Because the code is rather self explanatory.

Option Explicit

'Early binding is in use and references are made to:
'MS Excel 2013 (15.0) Object Library
'MS ADO Library version 6.1
'SQLite ODBC

Private Sub btnExcelReport1_Click()

Dim xlApp As Excel.Application
Dim xlWBook As Excel.Workbook
Dim xlWSheet As Excel.Worksheet
Dim xlRange As Excel.Range

Dim adoCnt As ADODB.Connection
Dim adoRst As ADODB.Recordset

Dim stCon As String
Dim stSql As String
Dim stMonth As String

Dim intRow As Integer
Dim intColCounter As Integer

intColCounter = 4

stCon = _
"Provider=MSDASQL.1;Driver={SQLite3 ODBC Driver};" & _
"Database=" & App.Path & "\prod.db3;" & _
"StepAPI=0;SyncPragma=;NoTXN=0;Timeout=;ShortNames=0;LongNames=0;NoCreat=0;" & _
"NoWCHAR=0;FKSupport=0;JournalMode=;OEMCP=0;LoadExt=;BigInt=0;JDConv=0;PWD=;"

stSql = "SELECT Dept, Month, Result AS Amount FROM Prod_Output;"

Set adoCnt = New ADODB.Connection
Set adoRst = New ADODB.Recordset

adoCnt.Open stCon
With adoRst
.CursorLocation = adUseClient
.Open stSql, adoCnt
End With

Set xlApp = New Excel.Application
Set xlWBook = xlApp.Workbooks.Open(App.Path & "\ChartReport.xltx")
Set xlWSheet = xlWBook.Worksheets(1)

If Not adoRst.RecordCount = 0 Then

adoRst.MoveFirst

Do While Not adoRst.EOF
stMonth = adoRst.Fields("Month").Value
Select Case stMonth
Case "January": intRow = 4
Case "February": intRow = 5
Case "Mars": intRow = 6
Case "April": intRow = 8
Case "May": intRow = 9
Case "June": intRow = 10
Case "July": intRow = 12
Case "Augusti": intRow = 13
Case "September": intRow = 14
Case "October": intRow = 16
Case "November": intRow = 17
Case "December": intRow = 18
End Select

If intColCounter = 8 Then intColCounter = 4

Set xlRange = xlWSheet.Cells(intRow, intColCounter)
xlRange.Value = adoRst.Fields("Amount").Value

intColCounter = intColCounter + 1

adoRst.MoveNext
Loop
Else
MsgBox "No records found!", vbCritical, "Classic VB6"
GoTo ExitSub
End If

xlWSheet.Protect Password:="A4Jax0"

With xlApp
.Visible = True
.UserControl = True
End With

ExitSub:
adoRst.Close
adoCnt.Close
Set adoRst = Nothing
Set adoCnt = Nothing

Set xlRange = Nothing
Set xlWSheet = Nothing
Set xlWBook = Nothing

End Sub

The next case has also been presented in the mentioned article about B4J and MS Excel. The code retrieves data from a SQLite databases and then populate a prepared template with data. Instead of working with individual cells, like the code above, the code “dump” the recordset in a range in the template. Smooth and fast!

Option Explicit

'Early binding is in use and references are made to:
'MS Excel 2013 (15.0) Object Library
'MS ADO Library version 6.1
'SQLite ODBC

Private Sub bynExcelReport2_Click()

Dim xlApp As Excel.Application
Dim xlWBook As Excel.Workbook
Dim xlWSheet As Excel.Worksheet
Dim xlRange As Excel.Range

Dim adoCnt As ADODB.Connection
Dim adoRst As ADODB.Recordset

Dim stCon As String
Dim stSql As String
Dim stMonth As String

Dim intRow As Integer
Dim intColCounter As Integer

stCon = _
"Provider=MSDASQL.1;Driver={SQLite3 ODBC Driver};" & _
"Database=" & App.Path & "\prod.db3;" & _
"StepAPI=0;SyncPragma=;NoTXN=0;Timeout=;ShortNames=0;LongNames=0;NoCreat=0;" & _
"NoWCHAR=0;FKSupport=0;JournalMode=;OEMCP=0;LoadExt=;BigInt=0;JDConv=0;PWD=;"

stSql = "SELECT Dept, Month, Result AS Amount FROM Prod_Output;"

Set adoCnt = New ADODB.Connection
Set adoRst = New ADODB.Recordset

adoCnt.Open stCon
With adoRst
.CursorLocation = adUseClient
.Open stSql, adoCnt
End With

Set xlApp = New Excel.Application
Set xlWBook = xlApp.Workbooks.Open(App.Path & "\PivotReport.xltx")
Set xlWSheet = xlWBook.Worksheets(1)
Set xlRange = xlWSheet.Range("C4")

If adoRst.RecordCount > 0 Then
xlRange.CopyFromRecordset adoRst
Else
MsgBox "No records found!", vbCritical, "Classic VB"
GoTo ExitSub
End If

xlWSheet.PivotTables(1).PivotCache.Refresh

With xlApp
.Visible = True
.UserControl = True
End With

ExitSub:
adoRst.Close
adoCnt.Close
Set adoRst = Nothing
Set adoCnt = Nothing

Set xlRange = Nothing
Set xlWSheet = Nothing
Set xlWBook = Nothing
Set xlApp = Nothing

End Sub

I admit that coding in Classic VB is still very fun. The output is a clean code that is easy to follow. Of course, if both procedures would be part of one class module, a great number of variables could have been removed.

I wish that Microsoft could have continued to develop Classic VB further then just drop it. What a killer app Classic VB would have been today as well…

All the best,
Dennis

PS: Of course, the code bases presented here can easily be converted to VBA 🙂

Leave a Reply

Your email address will not be published. Required fields are marked *

*

This site uses Akismet to reduce spam. Learn how your comment data is processed.