VBA: THE BENEFIT OF USING CLASS AND THE WAY TO USE, WITH A SIMPLE SAMPLE PART 2

Nov 22, 2020 · 9 min read · Excel VBA HOMEMADE object-oriented ·

Overview

Help me improve my English!

As you probably see, I'm not a native English speaker.
If you find an English expression that feel incorrect or awkward, please let me know.

Message box of Disqus is under the article.
Or my E-Mail is here.

ABOUT THIS ARTICLE

Hi, I'm Dede.

This article is a a sequel of a article I posted before.

VBA: THE BENEFIT OF USING CLASS AND THE WAY TO USE, WITH A SIMPLE SAMPLE PART 1

Here, I'm going to take anothier sample file and describe how to use class and the bbenefits in a different way from that in the previous article.
The sample class clsCreateNewExcel will express the benefits from encapsulation and routine processing in initialization and termination processes, which are excluded from TableCreater in the previous article.

You can download Access file created for explanation and view its source code from here!

CREATION ENVIRONMENT

Windows10
MSOffice 2019

OVERVIEW OF SAMPLE

I created a Access file containing Item Data table.

A user can execute different processes with buttons in Main Form:

Main Form

All of these buttons have a common processing:

Create a new Excel book on user's Desktop.

The individual processing for each button is in the following list:

Extract Item data where its unit price more than 10000 and post them to new book's sheet.
Extract Item data where its code starts with 'B' and post them to new book's sheet.
Get Item data from Web API and post them to new book's sheet.

I created a class module clsCreateNewExcel for the sake of book creation and management of book-relational objects.

clsCreateNewExcel CLASS

ROLE

The class instantiates a new Excel Application Interface, creates new Excel book, and stores objects which can manipulate them in itself.
And, it has a function which adds worksheet to the book every time it's called.

CODE

  1Option Compare Database
  2Option Explicit
  3
  4'**************************
  5'*Excel Book Creation Class
  6'**************************
  7
  8'Consts
  9Private currentSheetNum As Long
 10
 11'Vars
 12Private myXlApp As Object
 13Private myWorkBook As Object
 14Private dicWorkSheet As Dictionary 'store all sheet objects of the book
 15
 16
 17'******************************************************************************************
 18'*getter/setter
 19'******************************************************************************************
 20Public Property Get xlApplication() As Object
 21    Set xlApplication = myXlApp
 22End Property
 23
 24
 25Public Property Get Workbook() As Object
 26    Set Workbook = myWorkBook
 27End Property
 28
 29
 30Public Property Get WorkSheets(ByVal num As Long) As Object
 31    If Not dicWorkSheet.Exists(num) Then Call MsgBox("The Sheet does not exists.", vbExclamation, TOOL_NAME): Set WorkSheets = Nothing: Exit Property
 32    Set WorkSheets = dicWorkSheet.Item(num)
 33End Property
 34
 35
 36'******************************************************************************************
 37'******************************************************************************************
 38Private Sub Class_Initialize()
 39    
 40    'Consts
 41    Const FUNC_NAME As String = "Class_Initialize"
 42    
 43    'Vars
 44    
 45    On Error GoTo ErrorHandler
 46    
 47    'initial sheet number
 48    currentSheetNum = 1
 49    
 50    'instance of ExcelApp
 51    Set myXlApp = CreateObject("Excel.Application")
 52    With myXlApp
 53        'all processing are done n the background
 54        .Visible = False
 55        .ScreenUpdating = False
 56        .DisplayAlerts = False
 57    End With
 58    Set myWorkBook = myXlApp.Workbooks.Add
 59    Set dicWorkSheet = New Dictionary
 60    dicWorkSheet.Add currentSheetNum, myWorkBook.WorkSheets(currentSheetNum)
 61    
 62ExitHandler:
 63
 64    Exit Sub
 65    
 66ErrorHandler:
 67
 68    MsgBox "An error has occurred and the macro will be terminated." & _
 69           vbLf & _
 70           "Func Name:" & FUNC_NAME & _
 71           vbLf & _
 72           "Error No." & Err.Number & vbNewLine & _
 73           Err.Description, vbCritical, TOOL_NAME
 74        
 75    GoTo ExitHandler
 76        
 77End Sub
 78
 79
 80'******************************************************************************************
 81'******************************************************************************************
 82Private Sub Class_Terminate()
 83    
 84    'Consts
 85    Const FUNC_NAME As String = "Class_Terminate"
 86    
 87    'Vars
 88    
 89    On Error GoTo ErrorHandler
 90    
 91    'save the book to user's Desktop
 92    With CreateObject("WScript.Shell")
 93        myWorkBook.SaveAs .SpecialFolders("Desktop") & "\" & "Test-Excel-Class-" & Format(Now, "yyyymmddhhnnss") & ".xlsx"
 94    End With
 95    
 96    'restore ExcelApp settings
 97    With myXlApp
 98        .ScreenUpdating = True
 99        .DisplayAlerts = True
100    End With
101    
102    'close
103    myWorkBook.Close
104    myXlApp.Quit
105
106ExitHandler:
107    
108    Set dicWorkSheet = Nothing
109    Set myWorkBook = Nothing
110    Set myXlApp = Nothing
111    
112    Exit Sub
113    
114ErrorHandler:
115
116    MsgBox "An error has occurred and the macro will be terminated." & _
117           vbLf & _
118           "Func Name:" & FUNC_NAME & _
119           vbLf & _
120           "Error No." & Err.Number & vbNewLine & _
121           Err.Description, vbCritical, TOOL_NAME
122        
123    GoTo ExitHandler
124        
125End Sub
126
127
128
129'******************************************************************************************
130'*Function :add new sheet
131'*Return   :added sheet
132'******************************************************************************************
133Public Function addNewSheet() As Object
134    
135    'Consts
136    Const FUNC_NAME As String = "addNewSheet"
137    
138    'Vars
139    Dim ws As Object
140    
141    On Error GoTo ErrorHandler
142
143    Set addNewSheet = Nothing
144    
145    currentSheetNum = currentSheetNum + 1
146    'add new sheet at the end
147    Set ws = myWorkBook.WorkSheets.Add(After:=myWorkBook.WorkSheets(myWorkBook.WorkSheets.Count))
148    dicWorkSheet.Add currentSheetNum, ws
149    
150    Set addNewSheet = ws
151    
152ExitHandler:
153
154    Exit Function
155    
156ErrorHandler:
157
158    MsgBox "An error has occurred and the macro will be terminated." & _
159           vbLf & _
160           "Func Name:" & FUNC_NAME & _
161           vbLf & _
162           "Error No." & Err.Number & vbNewLine & _
163           Err.Description, vbCritical, TOOL_NAME
164        
165    GoTo ExitHandler
166        
167End Function
168

ENCAPSULATION

As you can see above, variable inner the class such as myXlApp and myWorkBook are declared in Private scope. So they can be only derived through Property Get procedure, that indicates we can't refer and get them directly.

In this way, it's called Encapsulation that variables inner class are protected from being changed except for ways we allowed.
By encapsulation, we can keep variables from being changed and removed wrongfully, remove potential bugs, enhance a perspective of code.

INITIALIZAITON AND TERMINATION

As you can see above class code too, in Class_Initialize, we can do the minimum number of tasks we want to do at once.

'The minimum number of tasks' is:

creating a new Excel Application interface
creating a new Excel book
storing a first worksheet object in the book to Dictionary object
hiding Excel App's behavior
stopping screen updating of Excel
deterring displaying any alert

on the other hand, Class_Terminate does:

restoring Excel App's settings
saving the book to user's Desktop
closing the book and Excel App

In this way, we are free from describing processing code of these minimum tasks outer the class and free from forgetting it.
Especially, in terms of Excel Application object, if you stored it to global variable and didn't set it Nothing after using it, Excel App instance will continue to run in the background. Routine processing frees you from this unexpected result.

OTHER CODE

getTableHeader

 1'******************************************************************************************
 2'*Function :get header data of target table
 3'*Arg      :table name
 4'*Arg      :array for gotten data
 5'*Return   :True > normal termination; False > abnormal termination
 6'******************************************************************************************
 7Public Function getTableHeader(ByVal tblName As String, ByRef pArrHeader() As String) As Boolean
 8    
 9    'Consts
10    Const FUNC_NAME As String = "getTableHeader"
11    
12    'Vars
13    Dim i As Long
14    
15    On Error GoTo ErrorHandler
16
17    getTableHeader = False
18    Erase pArrHeader
19    
20    With db.TableDefs(tblName)
21        ReDim pArrHeader(0 To .Fields.Count - 1)
22        For i = 0 To .Fields.Count - 1
23            pArrHeader(i) = .Fields(i).Name
24        Next
25    End With
26    
27    getTableHeader = True
28    
29ExitHandler:
30
31    Exit Function
32    
33ErrorHandler:
34
35    MsgBox "An error has occurred and the macro will be terminated." & _
36           vbLf & _
37           "Func Name:" & FUNC_NAME & _
38           vbLf & _
39           "Error No." & Err.Number & vbNewLine & _
40           Err.Description, vbCritical, TOOL_NAME
41        
42    GoTo ExitHandler
43        
44End Function
45

getTableDataBySQL

 1'******************************************************************************************
 2'*Function :get recordset data as a 2-dimentional array
 3'*Arg      :sql string for target recordset
 4'*Arg      :array for gotten data
 5'*Return   :True > normal termination; False > abnormal termination
 6'******************************************************************************************
 7Public Function getTableDataBySQL(ByVal sql As String, ByRef arrData() As Variant) As Boolean
 8    
 9    'Consts
10    Const FUNC_NAME As String = "getTableDataBySQL"
11    
12    'Vars
13    Dim rs As DAO.Recordset
14    Dim i As Long
15    Dim j As Long
16    
17    On Error GoTo ErrorHandler
18
19    getTableDataBySQL = False
20    Erase arrData
21    
22    Set rs = db.OpenRecordset(sql)
23    With rs
24        If .EOF Then GoTo TruePoint
25        .MoveLast
26        ReDim arrData(0 To .RecordCount - 1, 0 To .Fields.Count - 1)
27        .MoveFirst
28        
29        i = 0
30        Do Until .EOF
31            For j = 0 To .Fields.Count - 1
32                arrData(i, j) = .Fields(j).Value
33            Next j
34            i = i + 1
35            .MoveNext
36        Loop
37    End With
38
39TruePoint:
40
41    getTableDataBySQL = True
42    
43ExitHandler:
44    
45    If Not rs Is Nothing Then rs.Clone: Set rs = Nothing
46    
47    Exit Function
48    
49ErrorHandler:
50
51    MsgBox "An error has occurred and the macro will be terminated." & _
52           vbLf & _
53           "Func Name:" & FUNC_NAME & _
54           vbLf & _
55           "Error No." & Err.Number & vbNewLine & _
56           Err.Description, vbCritical, TOOL_NAME
57        
58    GoTo ExitHandler
59        
60End Function
61

postDataToSheet

 1'******************************************************************************************
 2'*Function :post data to sheet
 3'*Arg      :target sheet
 4'*Arg      :assigned sheet name
 5'*Arg      :aheader data array
 6'*Arg      :data array
 7'*Return   :True > normal termination; False > abnormal termination
 8'******************************************************************************************
 9Public Function postDataToSheet( _
10    ByVal tgtSheet As Object, _
11    ByVal sheetName As String, _
12    ByVal pArrHeader As Variant, _
13    ByVal pArrData As Variant _
14) As Boolean
15    
16    'Consts
17    Const FUNC_NAME As String = "postDataToSheet"
18    
19    'Vars
20    
21    On Error GoTo ErrorHandler
22
23    postDataToSheet = False
24    
25    With tgtSheet
26        .Name = sheetName
27        .Range(.cells(1, 1), .cells(1, UBound(pArrHeader) - LBound(pArrHeader) + 1)).Value = pArrHeader
28        .Range(.cells(2, 1), .cells(UBound(pArrData, 1) - LBound(pArrData, 1) + 2, UBound(pArrData, 2) - LBound(pArrData, 2) + 1)).Value = pArrData
29        'lines
30        .Range(.cells(1, 1), .cells(UBound(pArrData, 1) - LBound(pArrData, 1) + 2, UBound(pArrData, 2) - LBound(pArrData, 2) + 1)).Borders.LineStyle = xlContinuous
31        'column widths adjustment
32        .Range(.Columns(1), .Columns(UBound(pArrHeader) - LBound(pArrHeader) + 1)).AutoFit
33    End With
34
35    postDataToSheet = True
36    
37ExitHandler:
38
39    Exit Function
40    
41ErrorHandler:
42
43    MsgBox "An error has occurred and the macro will be terminated." & _
44           vbLf & _
45           "Func Name:" & FUNC_NAME & _
46           vbLf & _
47           "Error No." & Err.Number & vbNewLine & _
48           Err.Description, vbCritical, TOOL_NAME
49        
50    GoTo ExitHandler
51        
52End Function
53

getJsonFromAPI

 1'******************************************************************************************
 2'*Function :get Json string from specified URL
 3'*Arg      :URL
 4'*Return   :Json string
 5'******************************************************************************************
 6Public Function getJsonFromAPI(URL As String) As String
 7
 8    'Consts
 9    Const FUNC_NAME As String = "getJsonFromAPI"
10    
11    'Vars
12    Dim objXMLHttp As Object
13    
14    On Error GoTo ErrorHandler
15
16    getJsonFromAPI = ""
17    
18    Set objXMLHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
19        objXMLHttp.Open "GET", URL, False
20        objXMLHttp.Send
21
22
23    getJsonFromAPI = objXMLHttp.responseText
24    
25ExitHandler:
26
27    Exit Function
28    
29ErrorHandler:
30
31    MsgBox "An error has occurred and the macro will be terminated." & _
32           vbLf & _
33           "Func Name:" & FUNC_NAME & _
34           vbLf & _
35           "Error No." & Err.Number & vbNewLine & _
36           Err.Description, vbCritical, TOOL_NAME
37        
38    GoTo ExitHandler
39        
40End Function
41

DEMO

Push the 'Execute 1. + 2. + 3. + 4.' button, and you get a Excel book in your Desktop.

Unit Price over 1000

Item Code Starts With B

Data From WebAPI

SAMPLE AND SOURCE CODE

Please refer Here!

Translations:

"Japanese" |