Chapter 5: VBE- The Code Modules

 A project is a collection of objects, s.a. UserForms, and the VBA component of a document or template. VBA code modules are stored inside the Visual Basic Editor (VBE) which can be accessed by:

  • Click on the toolbar click button View Toolbars Visual Basic (make sure that it has a check mark).
  • Click on the VBE toolbar button:

 

              In the upper left corner of the VBE window is the Project Explorer, which you use to navigate among open projects.  In the lower left corner you'll find the Properties Window, which shows the available properties of the selected object or module. The main area of the VBE  is the Code Window, where you write/store the code for the selected object (module or UserForm). A UserForm is a custom dialog box. Each macro begins with a Sub and ends with End Sub with the VBA code in the middle. Below you will see how the various modules are laid out in the MWEP:

 

The Project Explorer gives you a tree-structured view of all the files inserted into the application. You can expand these and collapse branches of the views to get more or less detail. The VBE window displays forms, modules or other separators. If you want to select a form on its own simply double click on the project explorer window for a more detailed look.

            Modules make it easier to follow the flow of the application. A module has code that resembles a Word document in the way the script is organizational and typed. Once completed, these procedures can be run to control your Word project.

The 3 main types of modules used in the Word EMR Project are:

UserForm Code Modules

Contains the event procedures used by the controls on the UserForm. Controls include click buttons, list boxes, and drop down objects. If the code resides in a Global Code Module, then all you would have to do is to do a procedure, or sub routine ("Sub... End Sub") that calls up that code, s.a. "Call GlobalMacros.CalcAge"

Class Modules

Contains global assertions, including Let, Get, and Set procedures.

Global Code Modules

Contains custom macros and functions that are used in numerous UserForms or by toolbar objects. Most of your VBA code can go here, including sub routines (macros) and functions. Those beginning to program can place all of their code here and simply call up the code from anywhere in your project.

Here are the actual global and class modules used in the MWEP:

AutoMacros

            Here I placed all of the toolbar module codes that can later be selected to activate commands when toolbars are clicked. Here are the first few lines of code:

Option Explicit

' The following would be in the BrowseFolder function or class

Private Type BROWSEINFO

    hOwner As Long

    pidlRoot As Long

    pszDisplayName As String

    lpszTitle As String

    ulFlags As Long

    lpfn As Long

    lParam As Long

    iImage As Long

End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _

    "SHGetPathFromIDListA" (ByVal pidl As Long, _

    ByVal pszPath As String) As Long

 

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _

    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _

    As Long 

Private Const BIF_RETURNONLYFSDIRS = &H1

Sub autoexec()

On Error GoTo Proc_Error

    Load frmSplashscreen

    frmSplashscreen.Show

Proc_Exit:

Exit Sub

Proc_Error:

Call EMRError("WORD EMR Project.dot/Module AutoMacros: AutoExec()", Err.Number, Err.Source, Err.Description)

Resume Proc_Exit

End Sub

Public Function BrowseFolder(szDialogTitle As String) As String

    Dim X As Long, bi As BROWSEINFO, dwIList As Long

    Dim szPath As String, wPos As Integer, XX As String

    With bi

        .hOwner = hWndAccessApp

        .lpszTitle = szDialogTitle

        .ulFlags = BIF_RETURNONLYFSDIRS

    End With

    

    dwIList = SHBrowseForFolder(bi)

    szPath = Space$(512)

    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

    

    If X Then

        wPos = InStr(szPath, Chr(0))

        BrowseFolder = Left$(szPath, wPos - 1)

    Else

        BrowseFolder = vbNullString

    End If

    frmSplashscreen.TextBox2 = szPath

    yy = frmSplashscreen.TextBox2 & "\zfilemds_Scheduler.mdb"

    frmSplashscreen.TextBox2 = yy

    conDBpath2 = yy

    Select Case XX

        Case "welcome"

        Case "handouts"

            Call ListBoxFill1

        Case "workups"

            Call ListBoxFill2

        Call ListBoxFill2

    End Select

End Function

modEMRError

        Here I placed the code for error handling. Its fairly short (this is the complete module):

Option Explicit

Public Function EMRError(errMod As String, ErrNum As String, ErrSource As String, ErrDesc As String)

    Const LogFileName As String = "C:\EMRError.log"

Dim FileNum As Integer  

On Error Resume Next

    MsgBox "Erorr: " & ErrNum & vbNewLine & ErrDesc & vbNewLine & ErrSource, vbInformation, "Error in " & errMod

    FileNum = FreeFile

    Open LogFileName For Append As #FileNum

    Print #FileNum, "******************************************"

    Print #FileNum, "Date: " & Now()

    Print #FileNum, "Module: " & errMod

    Print #FileNum, "Number: " & ErrNum

    Print #FileNum, "Source: " & ErrSource

    Print #FileNum, "Description: " & ErrDesc

    Close #FileNum

End Function

modGlobals

        This is the main class module. Here is the beginning of the code:

Option Explicit

Public Const conDBpath As String = "C:\Program Files\Word EMR Project 2008\ZMDSBE.mdb"

Public conDBpath2 As String, yy As String, tt As String, uu As String, vv As String, ww As String

Public XX As String, xxx As String, zz As String, zzz As String, yyy As String, strTitle As String

Public Const conDebug As Boolean = True

Public lun As String, ptn As String, attgname1 As String, acctno As Long

Public street1 As String, age1 As Long, sex11 As String

Public citystatezip1 As String, NoOfRecords As Long, fvst1 As Date, MyTime, MySecond

Public Phones1 As String, ptaddress1 As String, racee As String, tt11 As String

Public db As DAO.Database, rs As DAO.Recordset, SQLStmt As String

Public xlapp As Object, schdateD As Date, act, aa As String, age2 As String

Public dd As Date, dd2 As Date, ii As Long, I As Long

Public ftit As String, worddoc1 As String, pdfdoc1 As String, szDialogTitle As String

Public lngDBTimesOpened As Long, pty As Property, lngProfileTimesOpened As Long

'----------------------------------------------------------------

Type BROWSEINFO   'private

    hOwner As Long

    pidlRoot As Long

    pszDisplayName As String

    lpszTitle As String

    ulFlags As Long

    lpfn As Long

    lParam As Long

    iImage As Long

End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _

    "SHGetPathFromIDListA" (ByVal pidl As Long, _

    ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _

    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _

    As Long

Private Const BIF_RETURNONLYFSDIRS = &H1

Option Compare Binary

' Note that although Variants now have

' a VT_GUID type, this type is unsupported in VBA,

' so we must define our own here that will have the same

' binary layout as all GUIDs are expected by COM to

' have.

Public Type GUID

    Data1 As Long

    Data2 As Integer

    Data3 As Integer

    Data4(7) As Byte

End Type

Public Declare Function StringFromGUID2 Lib "ole32.dll" _

    (rclsid As GUID, ByVal lpsz As Long, ByVal cbMax As Long) As Long

Public Declare Function CoCreateGuid Lib "ole32.dll" _

    (rclsid As GUID) As Long

Overview of a UserForm Module: the Initialize Subroutine of the SOAP Form

          Below we'll discuss the main code for the SOAP form, the most complicated UserForm. This is the code that sets up the various objects of this UserForm. Specifics will be discussed between the code snippets and more in depth in chapter 7 which describes important subroutine methods. Comments will be highlighted in green:

Sub UserForm_Initialize()
If conDebug Then On Error GoTo Proc_Error
Dim ee As String, ff As String

' set focus on the first tab
MultiPage1.TabIndex = 0

' begin defining/attaching the records to the various comboboxes

' in the first combobox code we'll explain it in depth
Set db = OpenDatabase(conDBpath2)
' Retrieve the recordset
Set rs = db.OpenRecordset("SELECT Persmd.[PERSONALMD], Persmd.[GROUP NAME], Persmd.PLNAME, Persmd.PFNAME, Persmd.PSTREET, Persmd.PCITYSTATEZIP, Persmd.PWPHONE, Persmd.PhPHONE, Persmd.PFPHONE, Persmd.EMAIL, Persmd.autono, Persmd.PSALUTATION, Persmd.TitlePhrases, Persmd.DEANO FROM Persmd ORDER BY Persmd.PERSONALMD;")
' Determine the number of retrieved records
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
' Set the number of Columns (2) = number of Fields in recordset minus 13
ComboBox1.ColumnCount = .Fields.Count - 13
' Load the ListBox with the retrieved records
ComboBox1.Column = .GetRows(NoOfRecords)
' Cleanup; close the recordset
.Close
End With

' here we set the width of the columns
tt = "4.6 in"
aa = "4.6 in"
ComboBox1.ColumnWidths = tt
ComboBox1.ListWidth = aa

' begin other combobox code lines, similar in theory to above
Set rs = db.OpenRecordset("SELECT DISTINCTROW PatientS.LUNAME, PatientS.FNAME, PatientS.DOB, PatientS.ACCT, PatientS.LNAME, PatientS.SEX, PatientS.ES, PatientS.SEX1, PatientS.MISCX, Patients.Street, Patients.City, Patients.State, Patients.Zip, Patients.HPhone, Patients.WPhone, Patients.fVst FROM PatientS ORDER BY PatientS.LNAME;")
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
frmSOAP.[PTNAME].ColumnCount = .Fields.Count - 15 '9
frmSOAP.[PTNAME].Column = .GetRows(NoOfRecords)
.Close
End With
tt = "4.8 in"
aa = "4.8 in"
frmSOAP.[PTNAME].ColumnWidths = tt
frmSOAP.[PTNAME].ListWidth = aa
Set rs = db.OpenRecordset("SELECT DISTINCTROW [CONSULTTYPE].[CONSULTTYPE], [CONSULTTYPE].[AUTONO] FROM CONSULTTYPE ORDER BY [CONSULTTYPE].[CONSULTTYPE];")
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
ReportType.ColumnCount = .Fields.Count
ReportType.Column = .GetRows(NoOfRecords)
.Close
End With
tt = "2.4 in"
uu = "0 in"
aa = "2.5 in"
ReportType.ColumnWidths = tt & ";" & uu
ReportType.ListWidth = aa

' Here the SOAP note page 2 is set up, filling all fields with ".";

' alternatively, one can check for null errors by using the "Nz([field], " ").
[ReportType] = "Discharge Note"
[PMH] = "."
[Allergies] = "."
[SH] = "."
[FH] = "."
[ROS] = "."
[PE] = "."
[DX1] = "."
[DX2] = "."
[DX3] = "."
[DX4] = "."
[PLAN] = "."
[CommandButton7].Caption = "(" & IIf(IsNull(frmSOAP.PTNAME3), 0, frmSOAP.ACCT) & ") " & IIf(IsNull(frmSOAP.[LNAME]), ".", [FNAME] & " " & [LNAME])
Set rs = db.OpenRecordset("SELECT DISTINCTROW PTDXLU.[DX] FROM PTDXLU ORDER BY PTDXLU.[DX];", dbOpenDynaset)
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
DX1.ColumnCount = .Fields.Count
DX1.Column = .GetRows(NoOfRecords)
End With
tt = "2.5 in"
aa = "2.5 in"
DX1.ColumnWidths = tt
DX1.ListWidth = aa
Set rs = db.OpenRecordset("SELECT SEXLUP.[SEX], SEXLUP.[ES], SEXLUP.[SEX1] FROM SEXLUP;")
With rs
.MoveLast
.MoveFirst
NoOfRecords = .RecordCount
combobox200.ColumnCount = .Fields.Count
combobox200.Column = .GetRows(NoOfRecords)
End With
XX = "0.5 in"
yy = "0 in"
tt = "0 in"
aa = "0.6 in"
combobox200.ColumnWidths = XX & ";" & yy & ";" & tt
combobox200.ListWidth = aa
Set rs = db.OpenRecordset("SELECT ZIPLU.ZIP, ZIPLU.CITY, ZIPLU.STATE FROM ZIPLU ORDER BY [ZIPLU].[ZIP];")
On Error Resume Next
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
ComboBox2.ColumnCount = .Fields.Count
ComboBox2.Column = .GetRows(NoOfRecords)
.Close
End With
XX = "1 in"
yy = "0 in"
tt = "0 in"
aa = "1.1 in"
ComboBox2.ColumnWidths = XX & ";" & yy & ";" & tt
ComboBox2.ListWidth = aa

' At this point the comboboxes with smaller amount of data are populated

' with the .AddItem method
With ComboBox5
.AddItem "frmHyperlinksHandouts"
.AddItem "frmHyperlinksWorkups"
.AddItem "frmReferral"
.AddItem "frmScheduler"
.AddItem "frmSplashscreen"
.AddItem "frmTheGenlLetter"
End With
With ComboBox15
.AddItem "frmHyperlinksHandouts"
.AddItem "frmHyperlinksWorkups"
.AddItem "frmReferral"
.AddItem "frmScheduler"
.AddItem "frmSplashscreen"
.AddItem "frmTheGenlLetter"
End With
With ComboBox25
.AddItem "frmHyperlinksHandouts"
.AddItem "frmHyperlinksWorkups"
.AddItem "frmReferral"
.AddItem "frmScheduler"
.AddItem "frmSplashscreen"
.AddItem "frmTheGenlLetter"
End With
With ComboBox35
.AddItem "frmHyperlinksHandouts"
.AddItem "frmHyperlinksWorkups"
.AddItem "frmReferral"
.AddItem "frmScheduler"
.AddItem "frmSplashscreen"
.AddItem "frmTheGenlLetter"
End With
'db.Close
MultiPage1.Value = 0
[Calendar1].Value = Date
Set rs = db.OpenRecordset("SELECT DISTINCTROW [PTDXLU].[DX] FROM PTDXLU ORDER BY [PTDXLU].[DX];")
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
DX2.ColumnCount = .Fields.Count
DX2.Column = .GetRows(NoOfRecords)
End With
tt = "2.5 in"
aa = "2.5 in"
DX2.ColumnWidths = tt
DX2.ListWidth = aa
Set rs = db.OpenRecordset("SELECT DISTINCTROW [PTDXLU].[DX] FROM PTDXLU ORDER BY [PTDXLU].[DX];")
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
DX3.ColumnCount = .Fields.Count
DX3.Column = .GetRows(NoOfRecords)
End With
tt = "2.5 in"
aa = "2.5 in"
DX3.ColumnWidths = tt
DX3.ListWidth = aa
Set rs = db.OpenRecordset("SELECT DISTINCTROW [PTDXLU].[DX] FROM PTDXLU ORDER BY [PTDXLU].[DX];")
With rs
.MoveLast
NoOfRecords = .RecordCount
.MoveFirst
DX4.ColumnCount = .Fields.Count
DX4.Column = .GetRows(NoOfRecords)
End With
tt = "2.5 in"
aa = "2.5 in"
DX4.ColumnWidths = tt
DX4.ListWidth = aa
If Len(lun) > 1 Then
frmSOAP.PTNAME = lun
Call PTNAME_Click
End If
If Len(attgname1) > 1 Then
frmSOAP.ComboBox1 = attgname1
Call ComboBox1_Click
End If
Exit Sub
Proc_Exit:
Exit Sub
Proc_Error:
Call EMRError("WORD EMR Project.dot/" & Me.Name & ": CommandButton11_Click()", Err.Number, Err.Source, Err.Description)
Resume Proc_Exit
End Sub

 

Saving Your VBA Project Frequently

 

              Word's VBE occasionally falters and freezes, and when this occurs there is no backup copy of your work. You need to remember to backup your work every 10 minutes or so. Save your changes (click the Save button on the Standard toolbar, press Ctrl+S, or choose File Save), and then choose File Close and Return to Microsoft Word to close the Visual Basic Editor and return to Word. Alternatively, press Alt+F11 to flip back to Word, leaving the Visual Basic Editor open so that you can return to it later if you need to make further changes.