home *** CD-ROM | disk | FTP | other *** search
- Sub TransferToCardbox()
- ' This VBA macro extracts information from the Worksheet and adds records
- ' to the active Cardbox database.
- ' The field names should be placed on the top row of the worksheet followed by
- ' the record values.
-
- Dim cbx As Object, cbwin As Object, cbrecs As Object, cbrec As Object
- ' Enable error trapping to inform the user if Cardbox for Windows is not running
- On Error GoTo CardboxNotRunning
- Set cbx = GetObject(, "Cardbox")
- ' Trap if no databases are open
- On Error GoTo NoActiveDatabase
- Set cbwin = cbx.ActiveWindow
- Set cbrecs = cbwin.Records
- On Error GoTo InvalidField
- ' Go to the worksheet and select the current region only
- Sheets("Sheet1").Select
- Selection.CurrentRegion.Select
- ' Loop through the rows of record information
- For Records# = 2 To Selection.Rows.Count
- ' Create a new record
- Set cbrec = cbrecs.New
- 'Loop through the field names and set the Cardbox field data
- For Fields# = 1 To Selection.Columns.Count
- cbrec.Fields(Trim(Cells(1, Fields#).Text)).Text = Cells(Records#, Fields#).Text
- Next Fields#
- ' Save the record but don't index until after all the records have been saved
- cbrec.SaveAndDeferIndexing
- Next Records#
- ' Update the index system in Cardbox
- cbrecs.UpdateIndex
- ' Move to cell A1
- Range("A1").Select
- End
- Exit Sub
-
- ' Catch errors here
- CardboxNotRunning:
- MsgBox ("Cardbox for Windows is not running")
- End
- NoActiveDatabase:
- MsgBox ("There are no databases open in Cardbox")
- End
- InvalidField:
- MsgBox ("There is an invalid field name")
- End
- End Sub
-
-
-