Visual Basic Code Sample

The Visual Basic code listed below is taken from a customized form (frmAckProcess.frm) that was written and updated by Tim Turnquist. It was written in the VBA API of a Contact Management application called The Raiser's Edge (aka RE) that is used at Common Hope.

This code demonstrates:

Style

Strict adherence to self-imposed guidelines to increase readability -- which improves maintainability -- as demonstrated by
- Concise in-line documentation that includes an outline, reason for the routine and history of the routine before any code (for example lines 8 - 80)
- All variables DIM'ed up front, grouped by variable type and a quick description of how the variable is used (for example lines 84 - 123)
- No line over 80 characters long (all lines -- set up on lines 1-3)
Error trapping and handing as described in Tyson Gil's book "Visual Basic 6: Error Coding and Layering" (for example lines 82 & 524 - 547)
The code follows the logic set up in the summary outline and uses comments to delimit sections (for example lines 9 - 19 & 135 - 137)
Uses easy to understand variable naming convention

Function

Interaction with data retrieved from user via the form (for example lines 139 - 174)
Form data validation (for example lines 139 - 174)
Interaction with other modules (for example line 179)
Interaction with external objects and data objects of The Raiser's Edge software (for example line 225)
Interaction with the system and files stored on disk (for example lines 195 - 204)
Use of code wrappers for multi-use code or objects (for example all calls to a module called 'GlobalCode' -- which is nothing more than a module full of code wrappers)
Use of complex data structures such as dictionaries, arrays and data objects (for example lines 430 - 450)

   1    '2345678901234567890123456789012345678901234567890123456789012345678901234567890
   2    '        1         2         3         4         5         6         7         8
   3    '------------------------------------------------------------------------------|
   4    Dim oQuery As CQueryObject                  'Global declaration of the RE object
   5
   6
   7    Sub CmdGo_Click()
   8    'This is the meat of the form!  It will:
   9    '    <01> Validate form values
  10    '    <02> Create the output files
  11    '    <03> Step through each gift record of the query
  12    '       <3a> Gather constituent data
  13    '       <3b> Gather all gift data for each gift for that constituent
  14    '       <3c> Determine if this constituent is to get an acknowledgement
  15    '            If so, make Key and copy to new dictionary
  16    '    <04> Sort the dictionaries
  17    '    <05> Write the Dictionaries to files
  18    '    <06> Handle messages, clean up and leave
  19    '    <07> Handle errors
  20    '
  21    ' Created by Tim Turnquist, Common Hope
  22    ' Version 1.0 Dec 01, 2003
  23    ' This routine is to replace a very long and more manual process for sorting
  24    ' gifts and deciding who should receive an acknowledgement.  The other reason
  25    ' for this new process is to keep all of the logic in one place -- in the old
  26    ' process, some was in RE (one query, three exports and a mail function) and
  27    ' some was in Access (several queries and macros).  This module uses one RE
  28    ' query 'ACK:Gifts to Acknowledge' and the rest of the logic is all here.
  29    '|-----------------------------------------------------------------------------|
  30    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
  31    '|----------+-----------+------------------+-----------------------------------|
  32    '| 12/01/03 | 1.0       | Tim Turnquist    |-Original Code                     |
  33    '|----------+-----------+------------------+-----------------------------------|
  34    '| 12/02/03 | 1.0.01    | Tim Turnquist    |-Changed the Addressee and the     |
  35    '|          |           |                  |  Salutations to get extra data if |
  36    '|          |           |                  |  constituent is an organization   |
  37    '|          |           |                  |-Changed the criteria for sponsors |
  38    '|          |           |                  |  to get acknowledgements so that  |
  39    '|          |           |                  |  now if they make a payment of    |
  40    '|          |           |                  |  over $130 they will get an       |
  41    '|          |           |                  |  acknowledgement                  |
  42    '|----------+-----------+------------------+-----------------------------------|
  43    '| 12/03/03 | 1.1       | Tim Turnquist    |-Moves output line to dictionary   |
  44    '|          |           |                  |  rather than printing directly to |
  45    '|          |           |                  |  a file.  This allows the records |
  46    '|          |           |                  |  to be sorted                     |
  47    '|          |           |                  |-Added the Bubble Sort function to |
  48    '|          |           |                  |  the Global Code module to sort   |
  49    '|          |           |                  |  the dictionary either Ascending  |
  50    '|          |           |                  |  or Descending                    |
  51    '|----------+-----------+------------------+-----------------------------------|
  52    '| 12/15/03 | 1.1.01    | Tim Turnquist    |-Changed how Addressee and         |
  53    '|          |           |                  |  Salutation are calcualted for    |
  54    '|          |           |                  |  organizations                    |
  55    '|          |           |                  |-Changed the calculation for the   |
  56    '|          |           |                  | status update to get rid of the   |
  57    '|          |           |                  | division by zero error            |
  58    '|----------+-----------+------------------+-----------------------------------|
  59    '| 12/17/03 | 1.2       | Tim Turnquist    |-Completely revamped how the       |
  60    '|          |           |                  |  records are processed and tab-   |
  61    '|          |           |                  |  ulated.  We now build temporary  |
  62    '|          |           |                  |  dictionarites to hold the const- |
  63    '|          |           |                  |  ituent data and fund data rather |
  64    '|          |           |                  |  than adding to a string variable.|
  65    '|          |           |                  |  This allows us to 'Sum' gifts    |
  66    '|          |           |                  |  made by a contituent to the same |
  67    '|          |           |                  |  fund -- like WtmSelfPay.         |
  68    '|          |           |                  |-Removed '\' from and in Addressee |
  69    '|          |           |                  | and salutation                    |
  70    '|----------+-----------+------------------+-----------------------------------|
  71    '| 07/07/04 | 1.2.1     | Tim Turnquist    |-Added the ability to select a     |
  72    '|          |           |                  | different addressee and salutation|
  73    '|          |           |                  | if the constituent has any.       |
  74    '|          |           |                  | In particular we are looking for  |
  75    '|          |           |                  | the 'Tax Statement' A & S to use  |
  76    '|          |           |                  | instead of the primary if needed. |
  77    '|----------+-----------+------------------+-----------------------------------|
  78    '|          |           |                  |                                   |
  79    '|----------+-----------+------------------+-----------------------------------|
  80
  81
  82        On Error GoTo HandleThis
  83
  84        'Strings
  85        Dim sFilePath As String             'holds the path to the output files
  86        Dim sStatus As String               'holds a value if the status is not OK
  87        Dim sRegFileName As String          'holds part of the filename for REG ACKs
  88        Dim sVisTmFileName As String        'holds part of the filename for WTM ACKs
  89        Dim sRegOutLine As String           'holds the line(s) to be output to REG
  90        Dim sWtmOutLine As String           'holds the line(s) to be output ot WTM
  91        Dim sOutLine As String              'temp hold the line(s) to be output
  92        Dim sAddressee As String            'a temp holding place for the addressee
  93        Dim sSalutation As String           'a temp holding place for the salutation
  94        Dim sKey As String                  'holds the dictionary key which will be
  95                                            'the total amount given by a constit and
  96                                            'the constit ID.
  97        Dim sContitID As String
  98
  99        'Numbers
100        Dim nRetVal As Long                 'holds the return value for msgboxes
101        Dim nRecCount As Long               'holds a count of the records processed
102        Dim nFindSlash As Long              'used to find is a slash appears in
103                                            'the addressee
104
105
106        'Objects
107        Dim oConstit As CRecord             'holds the current constit's record
108        Dim oFund As CFund                  'holds the data for the fund of the gift
109        Dim oGift As CGift                  'holds the data for the gift itself
110        Dim dicRegAck As New Dictionary     'holds all of the reg acks to be ack'ed
111        Dim dicWtmAck As New Dictionary     'holds all of the wtm acks to be ack'ed
112        Dim dicRegEnv As New Dictionary     'holds all of the reg gift envelope data
113        Dim dicWtmEnv As New Dictionary     'holds all of the wtm gift envelope data
114        Dim dicConstitData As New Dictionary
115        Dim dicGiftAmount As New Dictionary
116        Dim dicGiftDesc As New Dictionary
117
118        'Other
119        Dim bRegFileCheck As Boolean        'used to check to see if the file exists
120        Dim bVisTmFileCheck As Boolean      'used to check to see if the file exists
121        Dim bSpon As Boolean                'used to see if a constit is a spon
122        Dim vGift As Variant
123
124        'Initialize Variables
125        sStatus = ""
126        sFilePath = "\\Frankenstein\Godchild-New\Templates\Finance\" _
127                                                    & "Acknowledgements\AckBatches\"
128        sRegFileName = sFilePath & "Reg"
129        sVisTmFileName = sFilePath & "VisTm"
130        bReg = False
131        bWtm = False
132
133        UpdateStatus "Processing . . . "
134
135    '|-----------------------------------------------------------------------------|
136    '|  <01> Validate form values                                                  |
137    '|-----------------------------------------------------------------------------|
138
139        'Check batch number to ensure it is valid and has not been run before
140        If txtBatchNumber.Text <> "" Then
141            bRegFileCheck = GlobalCode.CheckFile _
142                (sRegFileName & "Ack\" & txtBatchNumber.Text & ".txt")
143            bVisTmFileCheck = GlobalCode.CheckFile( _
144                sVisTmFileName & "Ack\" & txtBatchNumber.Text & ".txt")
145            If bRegFileCheck Or bVisTmFileCheck Then
146                nRetVal = MsgBox _
147                        ("The batch already exists" & vbCrLf & "Overwrite?" _
148                        , vbInformation + vbYesNo _
149                        , "Acknowledgemnt Process")
150                If nRetVal = vbNo Then
151                    sStatus = "Try again"
152                    txtBatchNumber.SetFocus
153                    Me.Repaint
154                Else
155                    If bRegFileCheck Then
156                        GlobalCode.DeleteFile sRegFileName & "Ack\" _
157                            & txtBatchNumber.Text & ".txt"
158                    End If
159                    If bVisTmFileCheck Then
160                        GlobalCode.DeleteFile sVisTmFileName & "Ack\" _
161                            & txtBatchNumber.Text & ".txt"
162                    End If
163                End If
164            End If
165        Else
166            sStatus = "Blank"
167        End If
168
169        'Check Minimum Sponsorship Donation input to ensure it is valid
170        If Not (IsNumeric(txtMinSponDonation.Text)) Or txtMinSponDonation < 0 Then
171            sStatus = "Bad Min Donation"
172        End If
173
174        If sStatus = "" Then
175    '|-----------------------------------------------------------------------------|
176    '|  <02> Create the output files                                               |
177    '|-----------------------------------------------------------------------------|
178            'Create Output files
179            If GlobalCode.CheckFile(sRegFileName & "Ack.txt") Then _
180                GlobalCode.DeleteFile sRegFileName & "Ack.txt"
181            GlobalCode.CreateFile sRegFileName & "Ack.txt"
182            GlobalCode.WriteToFile sRegFileName & "Ack.txt" _
183                , "ConsID|FundID|Amount|FundDesc|TotAmount" _
184                    & "|Addressee|Sal|OrgName|Address~" & vbCrLf _
185                , 8
186            If GlobalCode.CheckFile(sVisTmFileName & "Ack.txt") Then _
187                GlobalCode.DeleteFile sVisTmFileName & "Ack.txt"
188            GlobalCode.CreateFile sVisTmFileName & "Ack.txt"
189            GlobalCode.WriteToFile sVisTmFileName & "Ack.txt" _
190                , "ConsID|FundID|Amount|FundDesc|TotAmount" _
191                    & "|Addressee|Sal|OrgName|Address~" _
192                , 8
193
194            'Create Envelope Files
195            If GlobalCode.CheckFile(sRegFileName & "Env.txt") Then _
196                GlobalCode.DeleteFile sRegFileName & "Env.txt"
197            GlobalCode.CreateFile sRegFileName & "Env.txt"
198            GlobalCode.WriteToFile sRegFileName & "Env.txt", _
199                "ConsID|Addressee|OrgName|Address~", 8
200            If GlobalCode.CheckFile(sVisTmFileName & "Env.txt") Then _
201                GlobalCode.DeleteFile sVisTmFileName & "Env.txt"
202            GlobalCode.CreateFile sVisTmFileName & "Env.txt"
203            GlobalCode.WriteToFile sVisTmFileName & "Env.txt" _
204                , "ConsID|Addressee|OrgName|Address~", 8
205
206            'Create History Files
207            GlobalCode.CreateFile sRegFileName & "Ack\" _
208                & txtBatchNumber.Text & ".txt"
209            GlobalCode.WriteToFile sRegFileName & "Ack\" _
210                & txtBatchNumber.Text & ".txt" _
211                , "ConsID|FundID|Amount|FundDesc|TotAmount" _
212                    & "|Addressee|Sal|OrgName|Address~" _
213                , 8
214            GlobalCode.CreateFile sVisTmFileName & "Ack\" _
215                & txtBatchNumber.Text & ".txt"
216            GlobalCode.WriteToFile sVisTmFileName & "Ack\" _
217                & txtBatchNumber.Text & ".txt" _
218                , "ConsID|FundID|Amount|FundDesc|TotAmount" _
219                    & "|Addressee|Sal|OrgName|Address~" _
220                , 8
221
222    '|-----------------------------------------------------------------------------|
223    '|   <03> Step through each gift record of the query                           |
224    '|-----------------------------------------------------------------------------|
225            Do While Not (oQuery.QuerySet.EOF)
226
227                'Load the Constituent
228                Set oConstit = New CRecord
229                oConstit.Init REApplication.SessionContext
230                oConstit.LoadByField uf_Record_CONSTITUENT_ID, _
231                    oQuery.QuerySet.FieldValue(4)
232
233                nRecCount = nRecCount + 1
234                If oQuery.QuerySet.NumberOfRecords > 0 Then _
235                    UpdateStatus "Processing record " & nRecCount & " of " _
236                    & oQuery.QuerySet.NumberOfRecords
237
238    '|-----------------------------------------------------------------------------|
239    '|       <3a> Gather constituent data                                          |
240    '|-----------------------------------------------------------------------------|
241               'Get Constituent ID
242                dicConstitData("ConstitID") = oQuery.QuerySet.FieldValue(4)
243
244                'Get Address
245                dicConstitData("Address") = _
246                    oConstit.Fields(RECORDS_fld_PREFERRED_ADDRESS)
247
248                'Get Addressee & Salutation (check to see if it is an ORG)
249                sAddressee = ""
250                sSalutation = ""
251                If oConstit.Fields(RECORDS_fld_ORG_NAME) <> "" Then
252                    For i = 1 To oConstit.Relations.Individuals.Count
253                        If oConstit.Relations.Individuals.Item(i).Fields _
254                                (INDIVIDUAL_fld_CONTACT_TYPE) = "Primary" Then
255                            sAddressee = oConstit.Relations.Individuals.Item(i) _
256                                .Fields(INDIVIDUAL_fld_NAME)
257                            If InStr(1, oConstit.Fields(RECORDS_fld_ORG_NAME) _
258                                , dicConstitData("Address") _
259                                , vbTextCompare) <= 0 Then
260                                    If oConstit.Relations.Individuals.Item(i).Fields _
261                                    (INDIVIDUAL_fld_PRIMARY_SALUTATION) = "" Then
262                                        ssalutaion = IIf(sAddressee = "", _
263                                        oConstit.Fields(RECORDS_fld_ORG_NAME), _
264                                        sSalutation = sAddressee & " and " & _
265                                        oConstit.Fields(RECORDS_fld_ORG_NAME))
266                                    Else
267                                        sSalutation = oConstit.Relations.Individuals. _
268                                        Item(i).Fields _
269                                               (INDIVIDUAL_fld_PRIMARY_SALUTATION) _
270                                        & " and " _
271                                        & oConstit.Fields(RECORDS_fld_ORG_NAME)
272                                    End If
273                            Else
274                                sSalutation = _
275                                    oConstit.Relations.Individuals.Item(i).Fields _
276                                    (INDIVIDUAL_fld_PRIMARY_SALUTATION)
277                            End If
278                            Exit For
279                        End If
280                    Next
281                    sSalutation = IIf(sSalutation = "", oConstit.Fields _
282                                                            (RECORDS_fld_ORG_NAME) _
283                            , sSalutation)
284                Else
285                    ' This FOR/NEXT loop checks to see if there are "Tax Statement"
286                    '                                                     A&S to use
287                    For i = 1 To oConstit.Salutations.Count
288                        If oConstit.Salutations.Item(i) _
289                                .Fields(CONSTITUENT_SALUTATION_fld_SAL_TYPE) _
290                                = "Tax Statement Addressee" Then _
291                            sAddressee = oConstit.Salutations.Item(i) _
292                                    .Fields(CONSTITUENT_SALUTATION_fld_SALUTATION)
293                        If oConstit.Salutations.Item(i) _
294                                .Fields(CONSTITUENT_SALUTATION_fld_SAL_TYPE) _
295                                = "Tax Statement Salutation" Then _
296                            sSalutation = oConstit.Salutations.Item(i) _
297                                    .Fields(CONSTITUENT_SALUTATION_fld_SALUTATION)
298                    Next i
299
300                    ' Otherwise use "Primary"
301                    If sAddressee = "" Then sAddressee = _
302                            oConstit.Fields(RECORDS_fld_PRIMARY_ADDRESSEE)
303                    If sSalutation = "" Then sSalutation = _
304                            oConstit.Fields(RECORDS_fld_PRIMARY_SALUTATION)
305                End If
306
307                nFindSlash = InStr(1, sAddressee, "and\")
308                If nFindSlash > 0 Then
309                    sAddressee = Mid(sAddressee, 1, nFindSlash + 2) _
310                        & Mid(sAddressee, nFindSlash + 4)
311                End If
312                dicConstitData("Addressee") = sAddressee
313                dicConstitData("Salutation") = sSalutation
314
315                'Get Orginaztion Name
316                dicConstitData("OrgName") _
317                        = oConstit.Fields(RECORDS_fld_ORG_NAME)
318
319    '|-----------------------------------------------------------------------------|
320    '|       <3b> Gather all gift data for each gift for that constituent          |
321    '|-----------------------------------------------------------------------------|
322                dicConstitData("RegGift") = False
323                dicConstitData("WtmGift") = False
324
325                Do
326
327                    Set oFund = New CFund
328                    oFund.Init REApplication.SessionContext
329                    oFund.LoadByField fufFUND_ID, oQuery.QuerySet.FieldValue(3)
330
331                    Set oGift = New CGift
332                    oGift.Init REApplication.SessionContext
333
334                    oGift.LoadByField gufGIFT_USERGIFTID, _
335                                                       oQuery.QuerySet.FieldValue(8)
336
337                    'Get Fund ID and Amount
338                    dicGiftAmount(oQuery.QuerySet.FieldValue(3)) = _
339                        dicGiftAmount(oQuery.QuerySet.FieldValue(3)) _
340                        + oQuery.QuerySet.FieldValue(2)
341
342                    'Get Fund Description
343                    If oFund.Attributes.Count > 0 Then
344                        dicGiftDesc(oQuery.QuerySet.FieldValue(3)) = _
345                            oFund.Attributes.Item(1).Fields(atfDESCRIPTION)
346                    End If
347
348                    'TotalAmount
349                    If oQuery.QuerySet.FieldValue(3) <> "5 Vision Team Self" Then _
350                        dicConstitData("TotalAmount") = _
351                                                    dicConstitData("TotalAmount") _
352                                                     + oQuery.QuerySet.FieldValue(2)
353
354                    'Fund Type
355                    Select Case oQuery.QuerySet.FieldValue(7)
356                    Case "WorkteamSelf"
357                        'Write the record to the Workteam File
358                        dicConstitData("WtmGift") = True
359                    Case "SponsorGift"
360                        'Is the gift from a sponsor?
361                        bSpon = False
362                        For i = 1 To oConstit.ConstituentCodes.Count
363                            If InStr(1, _
364                                oConstit.ConstituentCodes.Item(i).Fields _
365                                    (CONSTITUENT_CODE_fld_LONG_DESC_READONLY) _
366                                , "Sponsor-", vbTextCompare) <> 0 Then
367
368                                bSpon = True
369                                Exit For
370                            End If
371                        Next i
372
373                        If Int(oGift.Fields(GIFT_fld_Amount)) _
374                                >= Int(txtMinSponDonation.Text) _
375                                Or bSpon = False Then
376                        dicConstitData("RegGift") = True
377                        End If
378                    Case "Sponsorship"
379                        If Int(oGift.Fields(GIFT_fld_Amount)) _
380                                >= Int(txtMinSponDonation.Text) Then
381                            dicConstitData("RegGift") = True
382                        End If
383                    Case "Partnership"
384                        If Int(oGift.Fields(GIFT_fld_Amount)) >= 250 Then
385                            ' do nothing
386                        End If
387                    Case "Nondeductible"
388                        'Do Nothing
389                    Case "NonCommonHope"
390                        'Do Nothing
391                    Case Else
392                        'All other cases, then write to Regular
393                        dicConstitData("RegGift") = True
394                    End Select
395
396                    oQuery.QuerySet.MoveNext
397                Loop Until oQuery.QuerySet.FieldValue(4) <> _
398                        oConstit.Fields(RECORDS_fld_CONSTITUENT_ID)
399    '|-----------------------------------------------------------------------------|
400    '|       <3c> Determine if this constituent is to get an acknowledgement       |
401    '|            If so, make Key and copy to new dictionary                       |
402    '|-----------------------------------------------------------------------------|
403                'Regular Acknowledgements
404                If dicConstitData("RegGift") = True Then
405                    sKey = Format(dicConstitData("TotalAmount"), "0000000000.00") _
406                        & Format(dicConstitData("ConstitID") _
407                            , "0000000000")
408                    For Each vGift In dicGiftAmount.Keys
409                        If vGift <> "5 Vision Team Self" Then _
410                            dicRegAck.Item(sKey) = _
411                                dicRegAck(sKey) _
412                                & dicConstitData("ConstitID") & "|" _
413                                & vGift & "|" _
414                                & Format(dicGiftAmount(vGift), "$0.00") & "|" _
415                                & dicGiftDesc(vGift) & "|" _
416                                & dicConstitData("TotalAmount") & "|" _
417                                & dicConstitData("Addressee") & "|" _
418                                & dicConstitData("Salutation") & "|" _
419                                & dicConstitData("OrgName") & "|" _
420                                & dicConstitData("Address") & "~" & vbCrLf
421                    Next vGift
422                    dicRegEnv.Item(sKey) = _
423                         dicConstitData("ConstitID") & "|" _
424                        & dicConstitData("Addressee") & "|" _
425                        & dicConstitData("OrgName") & "|" _
426                        & dicConstitData("Address") & "~"
427                End If
428
429                'Workteam Self-pay Acknowledgements
430                If dicConstitData("WtmGift") = True Then
431                    sKey = Format(dicGiftAmount("5 Vision Team Self"), _
432                                                                  "0000000000.00") _
433                        & Format(dicConstitData("ConstitID") _
434                            , "0000000000")
435                    dicWtmAck.Item(sKey) = _
436                        dicConstitData("ConstitID") & "|" _
437                        & "5 Wktm Self Pay|" _
438                        & Format(dicGiftAmount("5 Vision Team Self"), "$0.00") _
439                                                                            & "|" _
440                        & dicGiftDesc("5 Vision Team Self") & "|" _
441                        & dicGiftAmount("5 Vision Team Self") & "|" _
442                        & dicConstitData("Addressee") & "|" _
443                        & dicConstitData("Salutation") & "|" _
444                        & dicConstitData("OrgName") & "|" _
445                        & dicConstitData("Address") & "~"
446                    dicWtmEnv.Item(sKey) = _
447                         dicConstitData("ConstitID") & "|" _
448                        & dicConstitData("Addressee") & "|" _
449                        & dicConstitData("OrgName") & "|" _
450                        & dicConstitData("Address") & "~"
451                End If
452
453                'Reset record variables
454                sAddressee = ""
455                sSalutation = ""
456                sKey = ""
457                oConstit.CloseDown
458                oFund.CloseDown
459                oGift.CloseDown
460                dicConstitData.RemoveAll
461                dicGiftAmount.RemoveAll
462                dicGiftDesc.RemoveAll
463            Loop
464    '|-----------------------------------------------------------------------------|
465    '|      <04> Sort the dictionaries                                             |
466    '|-----------------------------------------------------------------------------|
467
468            UpdateStatus "Sorting . "
469            Set dicRegAck = DicBubbleSort(dicRegAck, False)
470
471            UpdateStatus "Sorting . . "
472            Set dicRegEnv = DicBubbleSort(dicRegEnv, False)
473
474            UpdateStatus "Sorting . . . "
475            Set dicWtmAck = DicBubbleSort(dicWtmAck, False)
476
477            UpdateStatus "Sorting . . . . "
478            Set dicWtmEnv = DicBubbleSort(dicWtmEnv, False)
479
480    '|-----------------------------------------------------------------------------|
481    '|      <05> Write the Dictionaries to files                                   |
482    '|-----------------------------------------------------------------------------|
483            UpdateStatus "Writing Acknowledgements"
484
485            'Regular Acknowledgements
486            For i = 0 To dicRegAck.Count - 1
487                    GlobalCode.WriteToFile _
488                        sRegFileName & "Ack.txt" _
489                        , dicRegAck.Items(i) _
490                        , 8
491                    GlobalCode.WriteToFile _
492                        sRegFileName & "Env.txt" _
493                        , dicRegEnv.Items(i) _
494                        , 8
495                    GlobalCode.WriteToFile _
496                        sRegFileName & "Ack\" & txtBatchNumber.Text & ".txt" _
497                        , dicRegAck.Items(i) _
498                        , 8
499            Next i
500            'Add dummy line for last record of RegAck file
501            GlobalCode.WriteToFile _
502                    sRegFileName & "Ack.txt" _
503                    , "XXXXXXX|Dummy|$0.00|for nothing|0|Last Record|Last Record|" _
504                    & "|No Address~" _
505                    , 8
506
507            'Workteam Self-pay Acknowledgements
508            For i = 0 To dicWtmAck.Count - 1
509                    GlobalCode.WriteToFile _
510                        sVisTmFileName & "Ack.txt" _
511                        , dicWtmAck.Items(i) _
512                        , 8
513                    GlobalCode.WriteToFile _
514                        sVisTmFileName & "Env.txt" _
515                        , dicWtmEnv.Items(i) _
516                        , 8
517                    GlobalCode.WriteToFile _
518                        sVisTmFileName & "Ack\" & txtBatchNumber.Text & ".txt" _
519                        , dicWtmAck.Items(i) _
520                        , 8
521            Next i
522        End If
523
524    '|-----------------------------------------------------------------------------|
525    '|  <06> Handle messages, clean up and leave                                   |
526    '|-----------------------------------------------------------------------------|
527        Select Case sStatus
528            Case "Try again"
529                MsgBox "Enter a new batch name that is unique", , "Input Error"
530                txtBatchNumber.SetFocus
531            Case "Blank"
532                MsgBox "Please enter a Batch number.", , "Input Error"
533                txtBatchNumber.SetFocus
534            Case "Bad Min Donation"
535                MsgBox "The Minimum Donation does not make sense" & vbCrLf _
536                    & "Please input a number greater than zero (0)", , "Input Error"
537            Case Else
538                'Assume completed without error
539                MsgBox "There were " & nRecCount & " gifts processed" _
540                    & vbCrLf & dicRegAck.Count & " Regular Acknowldgements" _
541                    & vbCrLf & dicWtmAck.Count & " Workteam Acknowledgments" _
542                        , vbOKOnly, "Processing complete"
543        End Select
544
545    Leave:
546        UpdateStatus ""
547        Exit Sub
548
549    '|-----------------------------------------------------------------------------|
550    '|  <07> Handle errors                                                         |
551    '|-----------------------------------------------------------------------------|
552    HandleThis:
553        Debug.Print "Error in CmdGo_Click; Error Number " & Err.Number _
554                    & vbCrLf & "Description: " & Err.Description
555        UpdateStatus "Error in process . . ."
556        MsgBox "Error Number " & Err.Number _
557                    & vbCrLf & "Description: " & Err.Description _
558                    , vbInformation _
559                    , "Error in CmdGo_Click"
560        Resume Leave
561    End Sub
562
563    Private Sub cmdMark_Click()
564    ' Created by Tim Turnquist, Common Hope
565    ' Version 1.0 Dec 01, 2003
566    ' This routine flags all of the gifts processed as having been processed
567    '|-----------------------------------------------------------------------------|
568    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
569    '|----------+-----------+------------------+-----------------------------------|
570    '| 12/01/03 | 1.0       | Tim Turnquist    |-Original Code                     |
571    '|----------+-----------+------------------+-----------------------------------|
572    '| 12/15/03 | 1.1       | Tim Turnquist    |-Changed the calculation for the   |
573    '|          |           |                  | status update to get rid of the   |
574    '|          |           |                  | division by zero error            |
575    '|----------+-----------+------------------+-----------------------------------|
576    '| 12/18/03 | 1.2       | Tim Turnquist    |-Added checking for batch numbers  |
577    '|          |           |                  | to ensure that we do not mark any |
578    '|          |           |                  | as acknowledged that have not been|
579    '|          |           |                  | run yet.                          |
580    '|----------+-----------+------------------+-----------------------------------|
581    '|          |           |                  |                                   |
582    '|----------+-----------+------------------+-----------------------------------|
583        Dim nRecCount As Long
584        Dim oMarkQuery As CQueryObject
585        Dim oMarkGift As CGift
586        Set oMarkQuery = New CQueryObject
587        Dim dicBatches As New Dictionary
588        Dim sBatches As String
589        Dim vBatch As Variant
590        Dim nMarkCount As Integer
591
592        oMarkQuery.Init REApplication.SessionContext
593
594        'Load the using the Query name
595        oMarkQuery.LoadByField uf_QUERY_NAME, "ACK:Gifts to Acknowledge"
596
597        'Open the resultset for access
598        oMarkQuery.QuerySet.OpenQuerySet
599
600        Do While Not (oMarkQuery.QuerySet.EOF)
601            dicBatches(oMarkQuery.QuerySet.FieldValue("Gift Batch Number")) = _
602                dicBatches(oMarkQuery.QuerySet.FieldValue("Gift Batch Number")) + 1
603            oMarkQuery.QuerySet.MoveNext
604        Loop
605
606        For Each vBatch In dicBatches.Keys
607            sBatches = sBatches & IIf(sBatches = "", vBatch, ", " & vBatch)
608        Next vBatch
609
610        If dicBatches.Count > 1 Then
611            'Ask user to select batches
612            sBatches = InputBox("Which Batches to Mark Acknowledged?" _
613                & vbCrLf & vbCrLf _
614                     & "Please DELETE the batches below that you DO NOT wish to " _
615                     & "mark as Acknowledged.", "Mark Acknowledged", sBatches)
616        End If
617
618        If sBatches <> "" Then
619            'Open the resultset for access
620            oMarkQuery.QuerySet.OpenQuerySet
621
622            nRecCount = 0
623            nMarkCount = 0
624            Do While Not (oMarkQuery.QuerySet.EOF)
625                Set oMarkGift = New CGift
626                oMarkGift.Init REApplication.SessionContext
627                oMarkGift.LoadByField gufGIFT_USERGIFTID, _
628                                                   oMarkQuery.QuerySet.FieldValue(8)
629
630                If InStr(1, sBatches, oMarkGift.Fields(GIFT_fld_Batch_Number), _
631                                                             vbTextCompare) > 0 Then
632                    oMarkGift.Fields(GIFT_fld_Acknowledge_Date) = Date
633                    oMarkGift.Fields(GIFT_fld_Acknowledge_Flag) = "Acknowledged"
634                    oMarkGift.Save
635                    nMarkCount = nMarkCount + 1
636                End If
637
638                oMarkGift.CloseDown
639
640                nRecCount = nRecCount + 1
641                If oMarkQuery.QuerySet.NumberOfRecords > 0 Then _
642                    UpdateStatus "Processing record " & nRecCount & " of " _
643                    & oMarkQuery.QuerySet.NumberOfRecords _
644                    & "; " & nMarkCount & " records marked"
645                oMarkQuery.QuerySet.MoveNext
646            Loop
647        End If
648        oMarkQuery.CloseDown
649        UpdateStatus "Done! " & nMarkCount & " records marked as Acknowledged"
650    End Sub
651
652    Private Sub cmdRegEnv_Click()
653    ' Created by Tim Turnquist, Common Hope
654    ' Version 1.0 Dec 01, 2003
655    ' This routine opens the file for regular envelopes
656    '|-----------------------------------------------------------------------------|
657    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
658    '|----------+-----------+------------------+-----------------------------------|
659    '| 12/01/03 |    1.0    | Tim Turnquist    |-Original Code                     |
660    '|----------+-----------+------------------+-----------------------------------|
661    '|          |           |                  |                                   |
662    '|----------+-----------+------------------+-----------------------------------|
663        vPath = "C:\Program Files\Microsoft Office\Office10\Winword.EXE"
664        vParam = "\\Frankenstein\godchild-new\templates\finance\acknowledgements" _
665                & "\ack envelopes\Env #10 TY.doc"
666        Shell """" & vPath & """ """ & vParam & """", vbNormalFocus
667
668    End Sub
669
670    Private Sub cmdOpenRegTY_Click()
671    ' Created by Tim Turnquist, Common Hope
672    ' Version 1.0 Dec 01, 2003
673    ' This routine opens the file for regular acknowledgements
674    '|-----------------------------------------------------------------------------|
675    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
676    '|----------+-----------+------------------+-----------------------------------|
677    '| 12/01/03 |    1.0    | Tim Turnquist    |-Original Code                     |
678    '|----------+-----------+------------------+-----------------------------------|
679    '|          |           |                  |                                   |
680    '|----------+-----------+------------------+-----------------------------------|
681        Dim vPath, vParam
682        vPath = "C:\Program Files\Microsoft Office\Office10\Winword.EXE"
683        vParam = "\\Frankenstein\godchild-new\templates\finance\acknowledgements" _
684                & "\ack letters\General TY letter.doc"
685        Shell """" & vPath & """ """ & vParam & """"
686        'Shell "'" & vParam & "'"
687    End Sub
688
689
690    Private Sub cmdOpenWtmTY_Click()
691    ' Created by Tim Turnquist, Common Hope
692    ' Version 1.0 Dec 01, 2003
693    ' This routine opens the file for workteam acknowledgements
694    '|-----------------------------------------------------------------------------|
695    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
696    '|----------+-----------+------------------+-----------------------------------|
697    '| 12/01/03 |    1.0    | Tim Turnquist    |-Original Code                     |
698    '|----------+-----------+------------------+-----------------------------------|
699    '|          |           |                  |                                   |
700    '|----------+-----------+------------------+-----------------------------------|
701        Dim vPath, vParam
702        vPath = "C:\Program Files\Microsoft Office\Office10\Winword.EXE"
703        vParam = "\\Frankenstein\godchild-new\templates\finance\acknowledgements" _
704            & "\ack letters\Vision Team TY letter.doc"
705        Shell """" & vPath & """ """ & vParam & """", vbNormalFocus
706    End Sub
707
708    Private Sub cmdWtmEnv_Click()
709    ' Created by Tim Turnquist, Common Hope
710    ' Version 1.0 Dec 01, 2003
711    ' This routine opens the file for workteam envelopes
712    '|-----------------------------------------------------------------------------|
713    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
714    '|----------+-----------+------------------+-----------------------------------|
715    '| 12/01/03 |    1.0    | Tim Turnquist    |-Original Code                     |
716    '|----------+-----------+------------------+-----------------------------------|
717    '|          |           |                  |                                   |
718    '|----------+-----------+------------------+-----------------------------------|
719        Dim vPath, vParam
720        vPath = "C:\Program Files\Microsoft Office\Office10\Winword.EXE"
721        vParam = "\\Frankenstein\godchild-new\templates\finance\acknowledgements" _
722                & "\ack envelopes\Env #10 VTm-ack.doc"
723        Shell """" & vPath & """ """ & vParam & """", vbNormalFocus
724    End Sub
725
726    Private Sub txtMinSponDonation_Change()
727
728    End Sub
729
730    Private Sub UserForm_Initialize()
731    ' Created by Tim Turnquist, Common Hope
732    ' Version 1.0 Dec 01, 2003
733    ' This routine opens the query and sets the batch when the form initializes
734    '|-----------------------------------------------------------------------------|
735    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
736    '|----------+-----------+------------------+-----------------------------------|
737    '| 12/01/03 |    1.0    | Tim Turnquist    |-Original Code                     |
738    '|----------+-----------+------------------+-----------------------------------|
739    '|          |           |                  |                                   |
740    '|----------+-----------+------------------+-----------------------------------|
741    Set oQuery = New CQueryObject
742    oQuery.Init REApplication.SessionContext
743            ' "ACK:Gifts to Acknowledge" Query format
744            ' (01) Gift Date
745            ' (02) Gift Amount
746            ' (03) Fund ID
747            ' (04) Constituent ID
748            ' (05) Primary Addressee
749            ' (06) Gift Reference
750            ' (07) Fund Category
751            ' (08) Gift ID
752            ' (09) No Valid Address?
753            ' (10) Appeal ID
754            ' (11) Gift Batch Number
755            ' (12) Gift Acknowledge
756        'Load the using the Query name
757        oQuery.LoadByField uf_QUERY_NAME, "ACK:Gifts to Acknowledge"
758
759        'Open the resultset for access
760        oQuery.QuerySet.OpenQuerySet
761
762        If oQuery.QuerySet.NumberOfRecords < 1 Then
763            MsgBox "There are no records to process", vbExclamation _
764                & vbOKOnly, "Acknowledgment Process"
765        Else
766            txtBatchNumber.SetFocus
767            txtBatchNumber.Text = oQuery.QuerySet.FieldValue(11)
768        End If
769
770    End Sub
771
772    Private Sub UserForm_Terminate()
773    ' Created by Tim Turnquist, Common Hope
774    ' Version 1.0 Dec 01, 2003
775    ' This routine cleans up memory when the form closes
776    '|-----------------------------------------------------------------------------|
777    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
778    '|----------+-----------+------------------+-----------------------------------|
779    '| 12/01/03 |    1.0    | Tim Turnquist    |-Original Code                     |
780    '|----------+-----------+------------------+-----------------------------------|
781    '|          |           |                  |                                   |
782    '|----------+-----------+------------------+-----------------------------------|
783        oQuery.CloseDown
784        Set oQuery = Nothing
785    End Sub
786
787    Sub UpdateStatus(ByVal sMessage As String)
788    ' Created by Tim Turnquist, Common Hope
789    ' Version 1.0 Dec 01, 2003
790    ' This routine notifies the user of the progress by posting messages to the
791    'status area of the form and then repainting the form
792    '|-----------------------------------------------------------------------------|
793    '|   DATE   |  VERSION  |      AUTHOR      |          NOTES                    |
794    '|----------+-----------+------------------+-----------------------------------|
795    '| 12/01/03 |    1.0    | Tim Turnquist    |-Original Code                     |
796    '|----------+-----------+------------------+-----------------------------------|
797    '|          |           |                  |                                   |
798    '|----------+-----------+------------------+-----------------------------------|
799        With txtStatus
800            .Visible = True
801            .Locked = False
802            .Text = sMessage
803            .Locked = True
804        End With
805        Me.Repaint
806    End Sub