home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1995 April / PCPRO_595.ISO / cardbox / cbox-run / cbox.hlp / tocbox.txt < prev   
Encoding:
Text File  |  1995-01-27  |  1.5 KB  |  50 lines

  1. Sub TransferToCardbox()
  2. ' This VBA macro extracts information from the Worksheet and adds records
  3. ' to the active Cardbox database.
  4. ' The field names should be placed on the top row of the worksheet followed by
  5. ' the record values.
  6.  
  7. Dim cbx As Object, cbwin As Object, cbrecs As Object, cbrec As Object
  8. ' Enable error trapping to inform the user if Cardbox for Windows is not running
  9. On Error GoTo CardboxNotRunning
  10.  Set cbx = GetObject(, "Cardbox")
  11. ' Trap if no databases are open
  12. On Error GoTo NoActiveDatabase
  13.  Set cbwin = cbx.ActiveWindow
  14.  Set cbrecs = cbwin.Records
  15. On Error GoTo InvalidField
  16.  ' Go to the worksheet and select the current region only
  17.  Sheets("Sheet1").Select
  18.  Selection.CurrentRegion.Select
  19.  ' Loop through the rows of record information
  20.  For Records# = 2 To Selection.Rows.Count
  21.   ' Create a new record
  22.   Set cbrec = cbrecs.New
  23.   'Loop through the field names and set the Cardbox field data
  24.   For Fields# = 1 To Selection.Columns.Count
  25.     cbrec.Fields(Trim(Cells(1, Fields#).Text)).Text = Cells(Records#, Fields#).Text
  26.   Next Fields#
  27.  ' Save the record but don't index until after all the records have been saved
  28.  cbrec.SaveAndDeferIndexing
  29.  Next Records#
  30.  ' Update the index system in Cardbox
  31.  cbrecs.UpdateIndex
  32.  ' Move to cell A1
  33.  Range("A1").Select
  34. End
  35. Exit Sub
  36.  
  37. ' Catch errors here
  38. CardboxNotRunning:
  39.  MsgBox ("Cardbox for Windows is not running")
  40.  End
  41. NoActiveDatabase:
  42.  MsgBox ("There are no databases open in Cardbox")
  43.  End
  44. InvalidField:
  45.  MsgBox ("There is an invalid field name")
  46.  End
  47. End Sub
  48.  
  49.  
  50.