Time
& Expense Billing: Part II
This article may contain URLs that were valid when originally published, but now link to sites or pages that no longer exist. To maintain the flow of the article, we've left these URLs in the text, but disabled the links.
.gif)
An
Excellent Outlook
The
Code behind the Scenes
By Helen
Feddema
The
first installment of this two-part series began by explaining how to install
and use a Time & Expense Billing application, a program intended for consultants
and others who bill for their services. The application uses custom Outlook
Journal items to store information about hours worked and expenses incurred for
a client, and prints Word invoices containing the slip data.
Notably,
the Time & Expense Billing application doesn't use Access. While there's
definitely a trade off when it comes to database functionality (see Part I),
the upside is that almost all Office users have Word and Outlook, and can
therefore benefit from the application without having to add another program to
their systems. In this installment, I'll describe the VBScript and Visual Basic
for Applications (VBA) code that makes the application come to life. If you
aren't interested in coding, Part I is all you need to put the program to use.
Of course, you'll need to download it as well (see the end of this article for
details).
How the
Application Works
The Time
& Expense Billing application uses two dialects of Visual Basic: VBScript
is used for code behind the Outlook custom slip form, while VBA is used in the
Word template's ThisDocument
class module, behind the Office UserForm triggered by the template's New
event and macros in a standard module in the template project.
There
are significant differences between Outlook VBScript and Office VBA that must
be taken into account when coding in these dialects, as shown in FIGURE 1.
|
Office
VBA
|
Outlook
VBScript
|
|
Runs
from application-wide code in class modules, macro procedures in standard
modules, and code behind Office UserForms
|
Runs
from Outlook forms only
|
|
Has
the powerful VBE developer's environment
|
Has
the limited Script Editor development environment
|
|
Has a
full-featured Object Browser, listing objects belonging to other object
models as well as Outlook objects
|
Has a
limited Object Browser, listing only Outlook objects
|
|
Supports
data typing for variables
|
Doesn't
support data typing; all variables are of the Variant type
|
|
Supports
named constants for parameter and value settings
|
Doesn't
support most named constants for parameter and value settings; numeric values
must be used instead
|
|
Works
with application-wide events, such as selecting an Outlook folder or creating
a new Word document from a template
|
Works
only with Outlook form events, such as changing the value of an item field
|
FIGURE 1:
General differences between VBA and VBScript.
The Outlook
Form
The
Outlook custom form used for recording Time and Expense data (slip) is based on
a Journal form. This is because the standard Journal item on which it's based
has some built-in features that lend themselves to working with time data.
FIGURE 2
shows the declarations section of the code behind the forms module, with
variables declared without data type, as they must be in VBScript. There are
several constant declarations at the end of the variable declarations used to
simulate named constants for two folders that are extensively referenced in the
code.
Dim ctl, ctlClient, ctlEnd, ctlExpenses, ctlProject
Dim ctlRate, ctls, ctlStart, ctlWork
Dim dteEndTimer, dteStartTimer
Dim fFound
Dim fld
Dim ins
Dim intDepth, intRateCount
Dim itm, itmNew, itmOld, itms
Dim lngTextBoxDuration, lngTimerDuration
Dim lngTotalDuration
Dim nms
Dim pg, pgs
Dim prps, prpsNew, prpsOld
Dim ritms
Dim strCategory, strClientAbbrev, strMessage
Const olNotes = 12
Const olContacts = 10
FIGURE 2:
Declarations section of the VBScript form module.
The
form's Item_Open event handler (see FIGURE 3) calls functions to fill
the lists of several comboboxes on the form with arrays. This is necessary
because there's no way to bind a combobox or listbox to data on an Outlook
form. It also makes certain controls visible only for billed slips.
Function Item_Open()
Set prps = Item.UserProperties
Call FillClientList()
Call FillWorkList()
Call FillProjectList()
Call FillStandardRateList()
Call FillClientRateList()
Call FillExpenseList()
Call SlipType()
' Initialize spin button values.
prps("ChangeDate") = 0
prps("OldChangeDate") = 0
' Set this property back to False for a slip
' that was originally a copied slip.
prps("CopiedSlip") = False
If prps("Billed") = True Then
Set itm = Item.GetInspector
Set pgs = itm.ModifiedFormPages
Set pg = pgs("Slip"
Set ctls = pg.Controls
ctls("txtInvoiceDate").Visible = True
ctls("txtInvoiceNumber").Visible = True
ctls("lblInvoiceDate").Visible = True
ctls("lblInvoiceNumber").Visible = True
ctls("cmdZeroOut").Visible = False
End If
End Function
FIGURE 3:
The Outlook form's Item_Open event handler.
Since
there are no control events for controls on Outlook forms (except for the Click
event, primarily useful for command buttons), a Select Case statement in
the CustomPropertyChange form event - see Listing
One - is used instead of the Change or AfterUpdate events you
might use in VBA code for an Access form or Office UserForm. The strPropName
variable represents the name of the custom property that has changed, and each Case
represents the actions to perform when that custom property changes. The
following list contains comments on various Case clauses in this
event handler:
- SlipType: If the slip is changed from Time
to Expense (or vice versa), two functions are called to make changes to the
slip, primarily making certain controls visible and others invisible.
- Rate,
TotalTime: If the
slip is a Time slip, and the timer method is not FlatRate, the TotalCost field is calculated using regular rate and
cost fields.
- FlatRate,
FlatRateQuantity:
If the timer method is FlatRate and
the FlatRate amount is greater than
zero, the TotalCost field is calculated using flat rate fields.
- EndTime: If the timer method is TextBoxes,
and the EndTime property is not blank, this lengthy Case clause
performs the calculations needed to add time to the slip's TotalTime field from
the Start Time and End Time
text boxes. Checking for a date being equal to #1/1/4501# is required, because
in Outlook, that date is the equivalent of a blank date.
- ChangeDate: The spin button control on the
form is bound to this numeric field; a change in its value (up or down) is used
to increment or decrement the date in the SlipDate field. This roundabout
method is needed since the usual events of this control (SpinUp and SpinDown)
don't work on an Outlook form.
- Billed: The value of this custom field is
copied to the built-in Mileage field, so that it can be used in a
Restrict clause elsewhere in the code. The Mileage and
BillingInformation fields are useful for this purpose, since they can be used
in both Restrict and Find clauses.
The AddTimeFromTextBox
function (see FIGURE 4) illustrates use of the custom Journal item's Start,
End, and Duration fields, which are linked so that they perform the necessary
calculations automatically. Duration is the difference between Start and End,
in minutes. Using these fields eliminates the need to write code to do the
calculations. The code also illustrates the rather involved method of
referencing controls on an Outlook form; you have to work through the item's
Inspector, the ModifiedFormPages collection, and then the specific
page's Controls collection. Breaking the reference into its components
allows the ctls variable to be used for setting references to several
controls on the same form page.
Function AddTimeFromTextBox()
Set prps = Item.UserProperties
Set itm = Item.GetInspector
Set pgs = itm.ModifiedFormPages
Set pg = pgs("Slip")
Set ctls = pg.Controls
Set ctlStart = ctls("txtStartTime")
Set ctlEnd = ctls("txtEndTime")
If IsDate(ctlStart.Value) = False Then
MsgBox "Please enter a valid time in " + _
"the Start Time text box"
Exit Function
ElseIf IsDate(ctlEnd.Value) = False Then
MsgBox "Please enter a valid time " + _
"in the End Time text box"
Exit Function
End If
Item.Start = ctlStart.Value
Item.End = ctlEnd.Value
lngTotalDuration = prps("TotalTime")
lngTextBoxDuration = Item.Duration
End Function
FIGURE 4:
The AddTimeFromTextBox function.
The FillWorkList
function (see FIGURE 5) fills the list of the Work Type
combobox on the form with items picked up from notes located in the Work Types subfolder under the Notes
folder. I use notes in a subfolder as an equivalent of records in a one-field
table, using the AddItem method to add the Subject property of
each note to the list of the combobox. There are several other functions that
work in a similar manner to fill the lists of the Expense Type and Client
Project comboboxes.
This function also illustrates the syntax for referencing a standard local
Outlook folder, using the GetDefaultFolder method of the NameSpace
object.
Function FillWorkList()
Set itm = Item.GetInspector
Set pgs = itm.ModifiedFormPages
Set pg = pgs("Slip")
Set ctls = pg.Controls
Set ctlWork = ctls("cboWork")
Set nms = Application.GetNameSpace("MAPI")
Set fld = _
nms.GetDefaultFolder(olNotes).Folders("Work Types")
Set itms = fld.Items
itms.Sort "[Subject]"
If itms.Count = 0 Then
MsgBox "No work types to add to drop-down list"
Exit Function
End If
For Each itm in itms
ctlWork.AddItem itm.Subject
Next
End Function
FIGURE 5:
The FillWorkList function.
The Word
Template
The
invoice component of the Time & Expense Billing application consists of two
Word templates, which differ only in the layout of the first page. The Outlook
Invoice template is designed to print on plain paper, and the Outlook Perfed
Invoice template is designed to print on pages with a perforated return coupon
on the bottom of the first page. The Outlook Invoice.dot is discussed here;
both invoices have the same code.
The
invoice uses code in two event handlers located in the ThisDocument class module, which is under the Microsoft Word Objects folder in the template's project
in the Word VBE window. A UserForm is popped up from the template's New
event; this form is located under the Forms
folder of the template project. Two macros are also used; they're located in
the All standard module, under the Modules folder of the template project. FIGURE 6 shows the template
project in the Word VBE window, with the three folders expanded.
.jpg)
FIGURE 6: The Outlook Invoice
template project in the Word VBE window.
The two
event handlers in the ThisDocument class module are shown in Listing Two. The Document_New event simply makes
the new invoice document invisible, and displays the UserForm. The Document_Close
event is more complex; it checks the value of the KeyWords property (one
of the standard document properties visible on the Summary page of a Word template or document's properties sheet). If the KeyWords
property doesn't equal "No", a message box is displayed to ask
if the user wants to finalize the document.
Finalizing
the invoice involves saving the invoice number to a custom document property
(so the next invoice will use the next higher number), and also marks the
Outlook slips that were selected for the invoice as billed by setting their Billed
property to True. At the end of the procedure, the KeyWords
property is set to No, ensuring that after an invoice has been finalized, the
finalization question won't be asked again.
The Word
UserForm is shown in design view in FIGURE 7. The form has a Clients combobox, a Time
Slips listbox, an Expense Slips listbox, a button for changing the
document's path (if necessary), and Cancel
and OK buttons. The Clients combobox is filled from the form's Initialize event, shown in Listing Three.
.jpg)
FIGURE 7: The UserForm in
design view.
To
select the clients to display in the Clients
combobox, a Restrict clause is initially set up to filter by Categories
= "Client".
This creates a set of restricted items, but it may include clients who have no
outstanding slips, so a further restriction is needed. This is done by
iterating through the clients, and for each one, checking whether Mileage
= "Unbilled"
(the Mileage field was used to store this information just so it could be used
in a Restrict clause). If the count of unbilled slips is zero, the code
closes the document, with a message; if it's greater than zero, the client is
added to the redimensioned array, and then the array is written to the Clients combobox's list.
The Clients combobox's Change event calls functions that fill the Time Slips and Expense
Slips listboxes with
slips for the selected client. The function that fills the Time Slips listbox is shown in Listing Four. This
function iterates through the set of restricted Client
slips (set up in the Initialize
event) and adds a slip to the array if Billed = False, Hold = False, and SlipType
= "Time".
Several fields from the slip item are written to different columns of the
array, so they'll be available to the code later on (not all the columns are
displayed in the listbox). When the array has been filled, it's written to the
listbox's List property. A similar function is used to fill the Expense Slips listbox.
The code
on the OK button's Click event -
shown in Listing Five - fills the invoice document
with data from the selected slips. First, it checks that there's a folder for
the selected client under the Invoices folder, and creates it if it
doesn't exist, using the FileSystemObject object that belongs to the
Scripting Runtime library.
Next,
the last invoice number is picked up from the InvoiceNumber custom document property, and several document
properties are written with values from the selected client. These values will
be displayed in DocProperty fields in the top portion of the invoice.
The
listboxes are multi-select listboxes, allowing users to choose which slips to
include on the invoice. Next, the work and expense arrays are re-created,
excluding the slips that aren't selected, setting the Hold property to True
for non-selected slips. Additionally, the FlatRate property is checked,
so that if all the selected slips are flat rate slips, the FlatRate
macro can run at the end of invoice creation.
Additional
code does some reformatting of the invoice if the selected client uses client
projects; this requires extra subtotals on the invoice. The two tables in the
invoice document are filled cell-by-cell with Time and Expense slip data, and
subtotals and a grand total are created in called functions, using Word
calculated fields. Finally, if all the slips on the invoice are flat rate
slips, the FlatRate macro is called to reformat the invoice
appropriately.
A save
name is created for the invoice, including the client name and the current
date, and is displayed to the user in a confirmation message box; if the user
clicks OK, the invoice document is saved
with this name, and a value of "Yes" is saved to the document's
KeyWords field, so that when it's closed, the user will be asked to finalize
the invoice.
Notes
The Time
& Expense Billing application will work in either Office 97 (Outlook
98/Word 97) or Office 2000 (Outlook 2000/Word 2000), except for one component.
(It hasn't been tested with Outlook 97.) It will also work if you start in
Office 97 and then upgrade to Office 2000. If you start in Office 2000 and then
attempt to use the invoices in Office 97, you'll get one or more cryptic
errors, usually "ActiveX component can't create object" and/or "Cannot open
macro storage." These error messages indicate that you have the wrong type
library version selected in the Tools
| References dialog
box. Office can upgrade references when going up a version, but it can't
downgrade references (at least not the Outlook reference) when going down a
version.
If you
get these error messages when using a template in Office 97 after using it in
Office 2000, open the VBE (if it isn't already open), reset the code if
necessary (click the Reset button; it's a blue square). Then
drop down the Tools menu and select References. You will see a dialog box like the one shown in FIGURE 8.
.jpg)
FIGURE 8: The References
dialog box with a missing reference.
Uncheck
the Outlook 9.0 entry (it's marked "MISSING"), and
then locate and check the Outlook
98 type library item.
Click OK, and try again; the code should
work.
If you
don't find the Scripting Runtime item in the list of references, you probably
don't have the latest version of VBScript. This application requires VBScript
5.0 (or higher) since the new File System Object is used in the code. You can
download the current version of VBScript (5.5 at the time of writing) from the
Microsoft Web site at http://msdn.microsoft.com/en-us/library/ms950396.aspx.
To tell what version of VBScript you have, look at the properties sheet of
VBScript.dll, in the \Windows\System folder.
Helen
Feddema is an independent developer specializing in Microsoft Office
applications, concentrating on Access, Word, and Outlook. She has written or
co-authored several books on Access. Her most recent book is Data Access Objects: The Definitive Guide [O'Reilly, 2000]. Helen's currently writing Microsoft Access Inside
Out [Microsoft Press], and
an Outlook book for O'Reilly. She has also contributed chapters to several multi-author Office books,
including Special Edition: Outlook 2000 [QUE, 2000]. Helen has been a
regular contributor to Pinnacle's Smart Access and Office Developer journals and Woody's Underground Office newsletter, and is currently the editor of the biweekly ezine, Woody's Access Watch,
for which she writes the Access Archon column. Her Web site (http://www.helenfeddema.com)
features pages with Office code samples and past Access Archon columns. She can
be contacted at mailto:hfeddema@ulster.net.
Begin Listing One - CustomPropertyChange event handler
Sub Item_CustomPropertyChange(ByVal strPropName)
' MsgBox strPropName & "has been changed"
Set itm = Item.GetInspector
Set pgs = itm.ModifiedFormPages
Set pg = pgs("Slip")
Set ctls = pg.Controls
Set prps = Item.UserProperties
Select Case strPropName
Case "SlipType"
Call SlipType()
Call TimerMethod()
Case "ItemCost", "ItemQuantity"
If prps("SlipType") = "Expense" Then
prps("TotalCost") = _
prps("ItemCost") * prps("ItemQuantity")
End If
Case "Rate", "TotalTime"
If prps("SlipType") = "Time" And_
prps("TimerMethod") <> "Flat Rate" Then
prps("TotalCost") = _
prps("Rate") * prps("TotalTime")/60
End If
Case "FlatRate", "FlatRateQuantity"
If prps("FlatRate") > 0 And _
prps("TimerMethod") = "Flat Rate" Then
prps("TotalCost") = _
prps("FlatRate") * prps("FlatRateQuantity")
End If
Case "EndTime"
If prps("TimerMethod") = "TextBoxes" And _
prps("EndTime") <> #1/1/4501# Then
Call AddTimeFromTextBox()
strMessage = "Add this many minutes to Total Time?"
strDuration = InputBox(strMessage, _
"Confirmation", lngTextBoxDuration)
If IsNumeric(strDuration) = False Then
MsgBox "Please enter a number"
strDuration = InputBox(strMessage, _
"Confirmation", lngTextBoxDuration)
Else
lngTotalDuration = _
CLng(strDuration) + lngTotalDuration
prps("TotalTime") = lngTotalDuration
prps("TotalTime") = lngTotalDuration
prps("TotalCost") = _
prps("Rate") * prps("TotalTime")/60
End If
ctls("txtStartTime").Value = Null
ctls("txtEndTime").Value = Null
End If
Case "TimerMethod"
Call TimerMethod()
Case "ChangeDate"
If prps("ChangeDate") > prps("OldChangeDate") Then
prps("SlipDate") = prps("SlipDate") + 1
ElseIf prps("ChangeDate") < _
prps("OldChangeDate") Then
prps("SlipDate") = prps("SlipDate") - 1
End If
prps("OldChangeDate") = prps("ChangeDate")
Case "Billed"
' Copy value of Billed to Mileage so it can be used
' in a Restrict clause.
If prps("Billed") = True Then
Item.Mileage = "Billed"
ctls(cmdZeroOut).Visible = False
ElseIf prps("Billed") = False Then
Item.Mileage = "Unbilled"
ctls(cmdZeroOut).Visible = True
End If
Case "Hold"
' Copy value of Hold to Mileage so it can be used
' in a Restrict clause.
If prps("Hold") = True Then
Item.Mileage = "Held"
ElseIf prps("Hold") = False Then
Item.Mileage = "Unbilled"
End If
End Select
End Sub
End Listing
One
Begin Listing Two - ThisDocument class module
Private Sub Document_Close()
On Error GoTo ErrorHandler
Dim appOutlook As Outlook.Application
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itms As Outlook.Items
Dim ritms As Outlook.Items
Dim prps As Object
Dim lngInvoiceNumber As Long
Dim intResult As Integer
Dim jitm As Outlook.JournalItem
Dim strClient As String
Dim strMatch As String
Set prps = ActiveDocument.BuiltInDocumentProperties
If prps(wdPropertyKeywords) <> "No" Then
If ActiveDocument.Type = wdTypeDocument Then
intResult = MsgBox("Finalize invoice?", vbYesNo, _
"Question")
If intResult = vbYes Then
' Store incremented invoice number in template
' doc property.
Set prps = ActiveDocument.AttachedTemplate. _
CustomDocumentProperties
lngInvoiceNumber = prps.Item("InvoiceNumber") + 1
prps.Item("InvoiceNumber") = lngInvoiceNumber
Debug.Print _
"Storing invoice #: " & lngInvoiceNumber
Debug.Print "Reading newly stored invoice #: " & _
prps.Item("InvoiceNumber")
ActiveDocument.AttachedTemplate.Save
Set prps = ActiveDocument.CustomDocumentProperties
' Set up collection of just billed slips
' for this client.
Set appOutlook = _
CreateObject("Outlook.Application")
Set nms = appOutlook.GetNamespace("MAPI")
Set fld = nms.Folders("Personal Folders"). _
Folders("Time & Expense Slips")
Set itms = fld.Items
strClient = prps.Item("Client")
strMatch = "[BillingInformation] = " & Chr$(34) & _
strClient & Chr$(34)
Set ritms = itms.Restrict(strMatch)
' Mark slips as billed.
For Each jitm In ritms
If jitm.UserProperties("Hold") = False And _
jitm.UserProperties("Billed") = False Then
jitm.UserProperties("Billed") = True
jitm.UserProperties("InvoiceDate") = Date
jitm.UserProperties("InvoiceNumber") = _
lngInvoiceNumber
jitm.Save
End If
Next jitm
End If
End If
Set prps = ActiveDocument.BuiltInDocumentProperties
prps(wdPropertyKeywords) = "No"
Application.ActiveDocument.Save
Debug.Print "Value of Keywords: " & _
prps(wdPropertyKeywords)
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & _
Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub Document_New()
On Error GoTo ErrorHandler
' Hide Word document until OK button on
' UserForm is pressed.
Application.Visible = False
Load frmChooseClient
frmChooseClient.Show
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & _
Err.Description
Resume ErrorHandlerExit
End Sub
End Listing
Two
Begin Listing Three - UserForm's Initialize event handler
Private Sub UserForm_Initialize()
' Fill listbox with client names from Outlook.
On Error GoTo UserForm_InitializeError
Set appOutlook = GetObject(, "Outlook.Application")
Set nms = appOutlook.GetNamespace("MAPI")
Set fldContacts = nms.GetDefaultFolder(olFolderContacts)
Set fldSlips = nms.Folders("Personal Folders"). _
Folders("Time & Expense Slips")
Set citms = fldContacts.Items
Set ctlClient = Me.cboClients
Set jitms = fldSlips.Items
' Fill textbox with default Docs Path value.
strDocsPath = DocsPath()
' Set up Restrict clause to select clients
' from Contacts folder.
strCategory = "Client"
strMatch = "[Categories] = " & Chr$(34) & _
strCategory & Chr$(34)
Set ritms = citms.Restrict(strMatch)
intClientCount = ritms.Count
If intClientCount = 0 Then
MsgBox "No clients found"
Exit Sub
Else
Debug.Print intClientCount & " unfiltered clients"
End If
' Fill Clients listbox.
ReDim strClientArray(intClientCount - 1, 2)
intRow = 0
For Each citm In ritms
' Check whether there are any unbilled slips
' for this client.
If Len(citm.CompanyName) > 0 Then
strClient = citm.CompanyName
strMatch = "[BillingInformation] = " & Chr$(34) & _
strClient & Chr$(34) & _
" And [Mileage] = 'Unbilled' "
Set ritmsUnbilled = jitms.Restrict(strMatch)
intSlipCount = ritmsUnbilled.Count
Debug.Print intSlipCount & " unbilled slips for " & _
citm.CompanyName
If ntSlipCount > 0 Then
intRow = intRow + 1
End If
End If
Next citm
Debug.Print "Clients with unbilled invoices: " & intRow
If intRow = 0 Then
MsgBox "There are no clients with unbilled " + _
"invoices; canceling invoice creation"
ActiveDocument.Close (False)
Unload frmChooseClient
Application.Quit
Exit Sub
End If
intClientCount = intRow
ReDim strClientArray(intClientCount - 1, 2)
intRow = 0
For Each citm In ritms
' Check for unbilled slips for this client.
If Len(citm.CompanyName) > 0 Then
strClient = citm.CompanyName
strMatch = "[BillingInformation] = " & Chr$(34) & _
strClient & Chr$(34) & _
" And [Mileage] = 'Unbilled' "
Set ritmsUnbilled = jitms.Restrict(strMatch)
intSlipCount = ritmsUnbilled.Count
If intSlipCount > 0 Then
strClientArray(intRow, 0) = citm.CompanyName
strClientArray(intRow, 1) = citm.BusinessAddress
strClientArray(intRow, 2) = citm.FileAs
intRow = intRow + 1
End If
End If
Next
If intClientCount > 1 Then
WordBasic.SortArray strClientArray
End If
ctlClient.List() = strClientArray
UserForm_InitializeExit:
Exit Sub
UserForm_InitializeError:
If Err.Number = 429 Then
Set appOutlook = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No.: " & Err.Number & _
"; Description: " & Err.Description
Resume UserForm_InitializeExit
End If
End Sub
End Listing
Three
Begin Listing Four - FillTimeSlips function
Private Function FillTimeSlips()
' Called from cboClients_Change.
On Error GoTo ErrorHandler
Set appOutlook = GetObject(, "Outlook.Application")
Set nms = appOutlook.GetNamespace("MAPI")
Set fld = nms.Folders("Personal Folders").Folders( _
"Time & Expense Slips")
' Fill Time Slips listbox.
Set lst = Me.lstTimeSlips
intRow = 0
For Each jitm In ritms
Set ups = jitm.UserProperties
If ups("Billed") = False And _
ups("Hold") = False And _
ups("SlipType") = "Time" Then
Debug.Print "Client project: " & ups("ClientProject")
intRow = intRow + 1
End If
Next jitm
intWorkCount = intRow
Debug.Print "Work count: " & intWorkCount
If intWorkCount = 0 Then Exit Function
ReDim varWorkArray(intWorkCount - 1, 8)
intRow = 0
pblnAllFlatRate = True
For Each jitm In ritms
Set ups = jitm.UserProperties
If ups("Billed") = False And _
ups("Hold") = False And _
ups("SlipType") = "Time" Then
varProject = ups("ClientProject")
If arProject <> "" And _
IsNull(varProject) = False Then
varWorkArray(intRow, 0) = varProject
blnProject = True
End If
varWorkArray(intRow, 1) = _
Format(ups("SlipDate"), "m/d/yyyy")
varWorkArray(intRow, 2) = _
ups("WorkType") & " -- " & jitm.Subject
If ups("TimerMethod") = "Flat Rate" Then
varWorkArray(intRow, 4) = _
Format(ups("FlatRate"), "$#0.00")
Else
varWorkArray(intRow, 4) = _
Format(ups("Rate"), "$#0.00")
End If
If ups("TimerMethod") = "Flat Rate" Then
varWorkArray(intRow, 5) = ups("FlatRateQuantity")
Else
varWorkArray(intRow, 5) = _
Format(ups("TotalTime") / 60, "##0.00")
End If
varWorkArray(intRow, 6) = _
Format(ups("TotalCost"), "$##,##0.00")
If ups("TimerMethod") = "Flat Rate" Then
varWorkArray(intRow, 7) = "Flat Rate"
End If
varWorkArray(intRow, 8) = jitm.EntryID
intRow = intRow + 1
End If
Next jitm
With lst
.List() = varWorkArray
.ColumnWidths = "0 pt;49.95 pt;150 pt;15 pt;" + _
"44.95 pt;44.95 pt;62 pt;0 pt;0 pt"
.Height = 128
.Width = 380
End With
intRows = lst.ListCount - 1
For intItem = 0 To intRows
lst.Selected(intItem) = True
Next intItem
ErrorHandlerExit:
Exit Function
ErrorHandler:
If Err.Number = 429 Then
Set appOutlook = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No.: " & Err.Number & _
"; Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Function
End Listing
Four
Begin Listing Five - OK_Click event handler
Private Sub cmdOK_Click()
On Error GoTo cmdOK_ClickError
Dim strInvoicePath As String
Dim strShortDate As String
Dim strBillingAddress As String
Dim strClientAbbrev As String
Dim lngInvoiceNumber As Long
Dim strInvoiceNumber As String
Dim strText As String
Dim strSaveName As String
Dim strSaveNamePath As String
Dim strSaveStreet As String
Dim i As Integer
Dim strTestFile As String
Dim strMessageTitle As String
Dim strMessage As String
Dim strTitle As String
Dim intReturn As Integer
Dim strTest As String
Dim varItem As Variant
Dim intIndex As Integer
Dim intRow As Integer
Dim intRows As Integer
Dim intColumn As Integer
Dim intColumns As Integer
Dim lstTime As MSForms.ListBox
Dim stExpense As MSForms.ListBox
Debug.Print "All Flat Rate? " & blnAllFlatRate
Set ctlClient = cboClients
strDocsPath = Me.txtDocsPath
Debug.Print "Docs path: " & strDocsPath
If blnCancel = True Then Exit Sub
strClient = ctlClient.Column(0)
strClientAbbrev = ctlClient.Column(2)
Debug.Print "Client Abbreviation: " & strClientAbbrev
If strClient = "" Then
MsgBox "Please select a client"
Exit Sub
End If
' Check that there's an Invoices folder under the Documents
' folder, and create it if it's not found.
strInvoicePath = strDocsPath & "Invoices\"
Debug.Print "Invoice path: " & strInvoicePath
Set fso = CreateObject("Scripting.FileSystemObject")
Set sfld = fso.GetFolder(strInvoicePath)
' Check that there's a Client folder under the Invoices
' folder, and create it if it's not found.
strInvoicePath = strInvoicePath & strClientAbbrev
Debug.Print "Invoice save folder: " & strInvoicePath
Set sfld = fso.GetFolder(strInvoicePath)
strShortDate = Format(Date, "m-d-yyyy")
strBillingAddress = ctlClient.Column(1)
' Pick up last invoice number from template doc property.
Set prps = ActiveDocument.AttachedTemplate. _
CustomDocumentProperties
lngInvoiceNumber = prps.Item("InvoiceNumber")
Debug.Print "Last invoice #: " & lngInvoiceNumber
' Write info from contact item and incremented invoice
' number to Word custom doc properties of the
' current document.
Set prps = ActiveDocument.CustomDocumentProperties
prps.Item("InvoiceDate").Value = strShortDate
prps.Item("InvoiceNumber").Value = lngInvoiceNumber + 1
prps.Item("Client").Value = strClient
prps.Item("BillingAddress").Value = strBillingAddress
strInvoiceNumber = CStr(lngInvoiceNumber + 1)
Debug.Print "Invoice # string: " & strInvoiceNumber
' Make Word document visible.
Application.Visible = True
' Re-create work and expense arrays using just selected
' items from listboxes.
Set lstTime = Me.lstTimeSlips
intRows = lstTime.ListCount
Debug.Print "lstTime has " & intRows & " rows"
intRow = 0
If intRows > 0 Then
ReDim varWorkArray(intWorkCount - 1, 5)
For varItem = 0 To intRows -
Debug.Print "Examining " & _
lstTime.Column(2, varItem) & " item"
If lstTime.Selected(varItem) = True Then
' Check whether slip is Flat Rate or not; if all
' slips are Flat Rate, then FlatRate macro is run
' after invoice is created.
Debug.Print _
"Flat Rate: " & lstTime.Column(7, varItem)
If lstTime.Column(7, varItem) <> "Flat Rate" Then
pblnAllFlatRate = False
End If
varWorkArray(intRow, 0) = _
lstTime.Column(0, varItem)
varWorkArray(intRow, 1) = _
lstTime.Column(1, varItem)
varWorkArray(intRow, 2) = _
lstTime.Column(2, varItem)
varWorkArray(intRow, 3) = _
lstTime.Column(4, varItem)
varWorkArray(intRow, 4) = _
lstTime.Column(5, varItem)
varWorkArray(intRow, 5) = _
lstTime.Column(6, varItem)
intRow = intRow + 1
ElseIf lstTime.Selected(varItem) = False Then
' Set Hold = True for non-selected slips.
Debug.Print "EntryID of non-selected slip: " & _
lstTime.Column(8, arItem)
Call oldSlip(lstTime.Column(8, varItem))
End If
Next VarItem
End If
intWorkCount = intRow
Debug.Print _
"Value of blnAllFlatRate before writing to invoice: " _
& pblnAllFlatRate
Set lstExpense = Me.lstExpenseSlips
intRow = 0
intRows = lstExpense.ListCount
Debug.Print "lstExpense has " & intRows & " rows"
If intRows > 0 Then
ReDim varExpenseArray(intExpenseCount - 1, 5)
For varItem = 0 To intRows - 1
Debug.Print "Examining " & _
lstExpense.Column(2, varItem) & " item"
If lstExpense.Selected(varItem) = True Then
varExpenseArray(intRow, 0) = _
lstExpense.Column(0, varItem)
varExpenseArray(intRow, 1) = _
lstExpense.Column(1, varItem)
varExpenseArray(intRow, 2) = _
lstExpense.Column(2, varItem)
varExpenseArray(intRow, 3) = _
lstExpense.Column(4, varItem)
varExpenseArray(intRow, 4) = _
lstExpense.Column(5, varItem)
varExpenseArray(intRow, 5) = _
lstExpense.Column(6, varItem)
intRow = intRow + 1
ElseIf lstExpense.Selected(varItem) = False Then
' Set Hold = True for non-selected slips.
Debug.Print "EntryID of non-selected slip: " & _
lstExpense.Column(7, varItem)
Call HoldSlip(lstExpense.Column(7, varItem))
End If
Next varItem
intExpenseCount = intRow
End If
If intWorkCount + intExpenseCount = 0 Then
MsgBox "No slips selected; canceling invoice"
ActiveDocument.Close
Exit Sub
End If
If ntWorkCount = 0 Then
Selection.GoTo What:=wdGoToBookmark, _
Name:="ProfessionalServices"
Selection.Delete unit:=wdCharacter, Count:=1
GoTo Expense
End If
' Delete extra column in Hours table and widen
' description column if there are no client projects
' for this client.
Debug.Print "Client projects? " & blnProject
Selection.GoTo What:=wdGoToBookmark, Name:="Hours"
If blnProject = False Then
With Selection
.MoveRight unit:=wdCharacter, Count:=1
.SelectColumn
.Columns.Delete
.SelectColumn
.Cells.SetWidth ColumnWidth:=InchesToPoints(3.4), _
RulerStyle:=wdAdjustNone
.MoveLeft unit:=wdCharacter, Count:=2
.Cells.SetWidth ColumnWidth:=InchesToPoints(0.94), _
RulerStyle:=wdAdjustNone
.GoTo What:=wdGoToBookmark, Name:="Hours"
End With
ElseIf blnProject = True Then
' Remove first tab from Balance Due line.
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Balance Due"
.Forward = True
.Wrap = wdFindContinue
End With
With Selection
.Find.Execute
.EndKey unit:=wdLine, Extend:=wdExtend
.ParagraphFormat.TabStops.ClearAll
ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
.ParagraphFormat.TabStops.Add _
Position:=InchesToPoints(1.15), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
.ParagraphFormat.TabStops.Add _
Position:=InchesToPoints(6.5), _
Alignment:=wdAlignTabRight, _
Leader:=wdTabLeaderSpaces
End With
End If
' Fill Hours table from array.
Selection.GoTo What:=wdGoToBookmark, Name:="Hours"
For intRow = 0 To intWorkCount - 1
' Test for Work Type/Subject not being blank.
varItem = varWorkArray(intRow, 2)
If varItem lt;> "" And IsNull(varItem) = False Then
With Selection
If blnProject = True Then
' Paste Client Project name in first cell.
.TypeText Text:=varWorkArray(intRow, 0)
.MoveRight unit:=wdCell
End If
.TypeText Text:=varWorkArray(intRow, 1)
.MoveRight unit:=wdCell
.TypeText Text:=varWorkArray(intRow, 2)
.MoveRight unit:=wdCell
.TypeText Text:=varWorkArray(intRow, 3)
.MoveRight unit:=wdCell
.TypeText Text:=varWorkArray(intRow, 4)
.MoveRight unit:=wdCell
.TypeText Text:=varWorkArray(intRow, 5)
.MoveRight unit:=wdCell
End With
End If
Next intRow
If blnProject = False Then
Call WorkSubtotal
Else
Call WorkSubtotalProject(pblnAllFlatRate)
End If
Expense:
If intExpenseCount = 0 Then
Selection.GoTo What:=wdGoToBookmark, _
Name:="AdditionalCharges"
Selection.Delete unit:=wdCharacter, Count:=1
GoTo GrandTotal
End If
Selection.GoTo What:=wdGoToBookmark, Name:="Expenses"
Debug.Print "Client projects? " & blnProject
' Delete extra column in Expenses table and widen
' description column if there are no client projects
' for this client.
Debug.Print "Client projects? " & blnProject
If blnProject = False Then
With Selection
.GoTo What:=wdGoToBookmark, Name:="Expenses"
.MoveRight unit:=wdCharacter, Count:=1
.SelectColumn
.Columns.Delete
.SelectColumn
.Cells.SetWidth ColumnWidth:=InchesToPoints(3.4), _
RulerStyle:=wdAdjustNone
.MoveLeft unit:=wdCharacter, Count:=2
.Cells.SetWidth ColumnWidth:=InchesToPoints(0.94), _
RulerStyle:=wdAdjustNone
.GoTo What:=wdGoToBookmark, Name:="Expenses"
End With
ElseIf blnProject = True Then
' Remove first tab from Balance Due line.
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Balance Due"
.Forward = True
.Wrap = wdFindContinue
End With
With Selection
.Find.Execute
.EndKey unit:=wdLine, Extend:=wdExtend
.ParagraphFormat.TabStops.ClearAll
ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
.ParagraphFormat.TabStops.Add _
Position:=InchesToPoints(1.15), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
.ParagraphFormat.TabStops.Add _
Position:=InchesToPoints(6.5), _
Alignment:=wdAlignTabRight, _
Leader:=wdTabLeaderSpaces
End With
End If
' Fill Expenses table from array.
Selection.GoTo What:=wdGoToBookmark, Name:="Expenses"
For intRow = 0 To intExpenseCount - 1
' Test for Expense Type/Subject not being blank.
varItem = varExpenseArray(intRow, 2)
If varItem
<> "" And IsNull(varItem) = False Then
With Selection
If blnProject = True Then
' Paste Client Project name in first cell.
.TypeText Text:=varExpenseArray(intRow, 0)
.MoveRight unit:=wdCell
End If
.TypeText Text:=varExpenseArray(intRow, 1)
.MoveRight unit:=wdCell
.TypeText Text:=varExpenseArray(intRow, 2)
.MoveRight unit:=wdCell
.TypeText Text:=varExpenseArray(intRow, 3)
.MoveRight unit:=wdCell
.TypeText Text:=varExpenseArray(intRow, 4)
.MoveRight unit:=wdCell
.TypeText Text:=varExpenseArray(intRow, 5)
.MoveRight unit:=wdCell
End With
End If
Next intRow
If blnProject = False Then
Call ExpenseSubtotal
Else
Call ExpenseSubtotalProject
End If
GrandTotal:
' Create Grand Total.
Set prps = ActiveDocument.CustomDocumentProperties
curGrandTotal = curWorkSubtotal + curExpenseSubtotal
Debug.Print "Grand total: " & curGrandTotal
prps.Item("GrandTotal").Value = CStr(curGrandTotal)
If pblnAllFlatRate = True Then
If blnProject = False Then
Application.Run "FlatRate"
ElseIf blnProject = True Then
Application.Run "FlatRateSubheads"
End If
End If
Unload frmChooseClient
' Update DocProperty fields.
Selection.WholeStory
Selection.Fields.Update
Selection.HomeKey unit:=wdStory
' Create save name for invoice.
strSaveName = strClientAbbrev & " Invoice " _
& strInvoiceNumber & " - " & strShortDate & ".doc"
Debug.Print "Save name: " & strSaveName
strSaveNamePath = strInvoicePath & "\" & strSaveName
Debug.Print "Save name with path: " _
& vbCrLf & strSaveNamePath
' Ask whether user wants to save the document.
strMessageTitle = "Save document?"
strMessage = "Save this document as " & strSaveNamePath
intReturn = MsgBox(strMessage, vbYesNoCancel + _
vbQuestion + vbDefaultButton1, strTitle)
If intReturn = vbNo Then
GoTo cmdOK_ClickExit
ElseIf intReturn = vbYes Then
Set prps = ActiveDocument.BuiltInDocumentProperties
prps(wdPropertyKeywords) = "Yes"
ActiveDocument.SaveAs strSaveNamePath
ElseIf intReturn = vbCancel Then
GoTo cmdOK_ClickExit
End If
cmdOK_ClickExit:
Exit Sub
cmdOK_ClickError:
If Err.Number = 76 Then
Set sfld = fso.CreateFolder(strInvoicePath)
Else
MsgBox "Error No.: " & Err.Number & _
"; Description: " & Err.Description
End If
Resume cmdOK_ClickExit
End Sub
End Listing
Five