Command Button Question

[Desstro]

How can I set up a command button on a form to "move" the record from the original table to another table in the same database?

[Rawb]

Use an On Click Event with the following VBA Code in it.

  Dim wrk As Workspace
  Dim dbsdb1 As Database
  Dim rstTable1 As Recordset
  Dim rstTable2 As Recordset

  Dim strCriteria As String

  Set wrk = DBEngine(0)
  Set dbsdb1 = CurrentDb
  Set rstTable1 = dbsdb1.OpenRecordset("Name of Original Table", dbOpenDynaset)
  Set rstTable2 = dbsdb1.OpenRecordset("Name of Other Table", dbOpenDynaset)

  wrk.BeginTrans

  strCriteria = "Filter needed to find the record you want to move."

  rstTable1.FindFirst strCriteria

  If rstTable1.NoMatch Then
    MsgBox "No Record found!"
    GoTo FunctionCleanup
  End If

  Do Until rstTable1.NoMatch
    With rstTable2
      .AddNew
      ' You need a line like the following for EACH FIELD you want to copy over.
      ' Be sure to include an exclamation point (!) at the beginning of each Field name.
      !Field1 = rstTable1("Field1")
      .Update
    End With

    With rstTable1
      .Delete
    End With

    rstTable1.FindNext strCriteria
  Loop

  wrk.Commit

FunctionCleanup:
  wrk = Nothing
  dbsdb1 = Nothing
  rstTable1 = Nothing
   rstTable2 = Nothing

EDIT: Fixed my VBA Code so that it would seek through multiple Records properly. See Italicized and Underlined text for change.

[Desstro]

I do appreciate your response but this did not work. Probably my fault as I am fairly new to Access and VBA is not my strong suit yet. Even though I am pretty green in VBA I can't help but say that this seems a little excessive. Is there some kind of more wizardly way of accomplishing an "archive record" command button?

[Rawb]

I do appreciate your response but this did not work. Probably my fault as I am fairly new to Access and VBA is not my strong suit yet. Even though I am pretty green in VBA I can't help but say that this seems a little excessive. Is there some kind of more wizardly way of accomplishing an "archive record" command button?

Unfortunately not. The only way(s) to do this all involve VBA Code. There's another method that uses a mixture of VBA and Queries, but it's just as difficult to follow. . .

Maybe if you could give me information about the two tables you're using, I could complete the code myself so that you could just copy and paste it? For me to make the code viable, I'd neet to know the table names and the names of all the fields in them.

[pbaldy]

As noted, you basically have to append into the new table and then delete from the old. You can use queries or code. That said, it is usually not a good idea to archive records. Typically it's better to leave them in the same table, but with an extra field to designate their status. That way you can easily query old, new or both as desired.

[TheShabz]

exactly what pbaldy said. The concept of removing "old" data from an Access table is really irrelevant. All you need is to add a field called StatusInd (Indicator) and set one value for active, another for inactive. Sometimes it's best to use -1 and 0, respectively, so you can then create yes/no objects (checkboxes) on a form.

[Desstro]

Pbaldy/Shabz,

While I completely understand and agree with you, unfortunately this is not the way my boss wants it set up.

Rawb,

Thank you for your continuing support.

Table 1: Packages Received
Fields: (primary key) PKG# - Where Am I - Program-Facility Area - Skid/Mod/Pad - RAT - LUG - Past Due - RT Items - UT Items - Received Date - Complete Date - Posted Date

Table 2: Posted Packages
Fields: (primary key) PKG# - Received Date - Complete Date - Posted Date

In a nut shell, I am trying to get the command button on the form generated from table one under the posted date field (POST BUTTON) to remove the record from table one and move only the 4 fields into table 2.

I hope this helps, and once again thank you in advance for your continued support.

On a side note, all fields are text with the exception of RAT, LUG, Past Due which are yes/no and the dated fields are obviously set as date/time. And RT and UT Items are set as number.

The where am I in the table is text but in the form is set as a combo box.

[pbaldy]

If your boss is a competent database designer, (s)he should determine the layout. If not... I'm so glad I work in an environment where they just tell me what they need, not how to do it.

I still disagree, but the simplest solution is to create an append query with the appropriate criteria and a delete query with the same criteria, and execute them. You typically want to make sure the append was successful before doing the delete. I actually do archive a couple of tables, but I do it in SQL Server, so the methodology is a little different. Rawb's method is also fine, though I would filter the source recordset when I opened it, not after the fact. It would be more efficient.

[Desstro]

Nobody here is a competent database designer. In fact, it wasn't until I came back from a 5 day Access class that the thought of even using a database was on the table. We have been using Excel to do everything. Using Excel for most of the things we are using it for is just dumb and we have way too many trackers and brios and then of course every department has their own "copy of" it all so it is just a giant mess and we are in definite need of a database run system of work tracking. I am trying to be the champion of this and am slowly understanding more and more of designing in Access but need help.

During and after the class I realized how much of a positive impact it would be in all aspects of this company so as a night shift worker I am slowly and quietly working on making a database to suit all of what we do. I want it to be perfect before I release it so I appreciate all the feedback and will speak to my boss about your suggestion but I am sure he will want to segregate the two tables still.

[pbaldy]

At the end of the day, you have to live and work with it, not us, so do what you feel is best. We'll always recommend what we think is best but try to help you do whatever you're trying to do. If the nature of the data is such that sometimes you'll want to query table1, sometimes table2, and sometimes everything together, it should be in one table. If not, maybe this is one of those times when it's appropriate to separate them. You know your data better than we do; we can just offer our experience, which says that in most situations you're better off with one table in the long run.

Good luck and post back if you need help with whichever direction you go in.

[Rawb]

Table 1: Packages Received
Fields: (primary key) PKG# - Where Am I - Program-Facility Area - Skid/Mod/Pad - RAT - LUG - Past Due - RT Items - UT Items - Received Date - Complete Date - Posted Date

Table 2: Posted Packages
Fields: (primary key) PKG# - Received Date - Complete Date - Posted Date

Unfortunately VBA Code is going to be really hard (impossible?) to set up in your current table setup. . .

I'd recommend changing the fields on all of your tables to remove any slashes, pound signs, dashes, and spaces. You'll probably also want to change your table names by taking out the spaces.

If your boss has said that the fields HAVE to be called what they are, you can make them look that way by entering that information in the "Caption" section of each field. This will make the table show those values any time the contents of the table is viewed, be it directly or through a Query.

That said, and assumed, the following code should work for you. All you'll have to do is change the name of your Posted Date textbox to "PostedDate". Then make an On Click Event and replace everything inside the function call with the following code.

  ' Catch errors!
  On Error GoTo Error_PostRecords

  ' Set up our variables
  Dim work As Workspace
  Dim rstPackagesReceived As DAO.Recordset
  Dim rstPostedPackages As DAO.Recordset

  Dim nbrCurrRecord, nbrRecords As Integer

  Set work = DBEngine(0)
  Set rstPackagesReceived = CurrentDb().OpenRecordset("SELECT * FROM PackagesReceived WHERE [PostedDate]=#" & Me!PostedDate & "#", dbOpenDynaset)
  Set rstPostedPackages = CurrentDb().OpenRecordset("PostedPackages", dbOpenDynaset)

  ' Turn the mouse cursor into an hourglass so the user knows we're doing something important.
  DoCmd.Hourglass True

  ' Check to see if we have any records with a matching PostedDate
  If rstPackagesReceived.RecordCount < 1 Or rstPackagesReceived.BOF Or rstPackagesReceived.EOF Then
    ' If we don't have any records, tell the user and then exit the function.
    MsgBox "No packages to transfer for date " & Me!PostedDate & "."

    GoTo FunctionCleanup
  End If

  ' Begin a transaction so we can undo everything if we have problems.
  work.BeginTrans

  ' Force Access to load all the records so we can get an accurate count below.
  rstPackagesReceived.MoveLast

  ' Set up a couple variables so we can track where we are
  nbrRecords = rstPackagesReceived.RecordCount
  nbrCurrRecord = 1

  ' Go back to the first record so we can execute our loop below.
  rstPackagesReceived.MoveFirst

  ' Loop through each record found with a matching PostedDate
  Do Until rstPackagesReceived.EOF
    ' For each record, add it to the PostedPackages Table.
    With rstPostedPackages
      .AddNew
      !PKG = rstPackagesReceived("PKG")
      !ReceivedDate = rstPackagesReceived("ReceivedDate")
      !CompleteDate = rstPackagesReceived("CompleteDate")
      !PostedDate = rstPackagesReceived("PostedDate")
      .Update
    End With

    ' For each record, delete it from the PackagesReceived Table
    With rstPackagesReceived
      .Delete
    End With

    ' Move to the next record and start our loop over.
    nbrCurrRecord = nbrCurrRecord + 1

    ' Make sure we're not trying to move past the last record.
'    If Not nbrCurrRecord > nbrRecords Then
      rstPackagesReceived.MoveNext
'    End If
  Loop

  ' If we made it through the loop without running into any errors, save our changes to the database.
  work.CommitTrans

  ' Tell the user how many records were transferred.
  If Not nbrRecords = 1 Then
    ' If there was a single record transferred, don't refer to the number plurally (is that even a word?).
    MsgBox CStr(nbrRecords) & " package transferred successfully."
  Else
    ' If there were more than 1, then use the plural form.
    MsgBox CStr(nbrRecords) & " packages transferred successfully."
  End If

  GoTo FunctionCleanup

' If we do run into an error, do the following code block.
Error_PostRecords:
  ' Undo any changes to the database so we don't lose any data or end up with duplicate records.
  work.Rollback

  ' Alert the user that something went wrong.
  MsgBox "The following error occured while attempting to transfer Posted Packages. Please contact your System Administrator." & _
         vbCrLf & vbCrLf & Chr(34) & Err.Description & Chr(34)

  Resume FunctionCleanup

' If everything went well, run the following code block before exiting the function.
FunctionCleanup:
  ' Give the user back their mouse.
  DoCmd.Hourglass False

  ' Clean up our variables
  rstPackagesReceived.Close
  rstPostedPackages.Close

  Set work = Nothing
  Set rstPackagesReceived = Nothing
  Set rstPostedPackages = Nothing

  Exit Sub

[Desstro]

GoTo FunctionCleanup

' If we do run into an error, do the following code block.
Error_PostRecords:
' Undo any changes to the database so we don't lose any data or end up with duplicate records.
work.Rollback

When I copy past the code you wrote, I get the following error: Run-Time Error "You tried to commit or rollback a transaction without first beginning a transaction."

When I debug, the work.rollback bolded above is highlighted.

I made the changes you suggested with regards to spaces, pound signs, etc...

Any suggestions?

[Rawb]

GoTo FunctionCleanup

' If we do run into an error, do the following code block.
Error_PostRecords:
' Undo any changes to the database so we don't lose any data or end up with duplicate records.
work.Rollback

When I copy past the code you wrote, I get the following error: Run-Time Error "You tried to commit or rollback a transaction without first beginning a transaction."

When I debug, the work.rollback bolded above is highlighted.

I made the changes you suggested with regards to spaces, pound signs, etc...

Any suggestions?

My guess is that it's one of two things. Either you don't have the "Microsoft DAO 3.6 Object Library" set up for this project, or I just didn't do a good enough job of trapping possible errors.

To see if you have the Library, Open up your VBA Code and click on Tools -> References. . .
Find "Microsoft DAO 3.6 Object Library" in the list and, if there's not a checkmark next to it, put one there.

Then, to fix the code itself, replace my old code with the following:

 ' Catch errors!
  On Error GoTo Error_PostRecords

  ' Set up our variables
  Dim work As Workspace
  Dim rstPackagesReceived As DAO.Recordset
  Dim rstPostedPackages As DAO.Recordset

  Dim boolTransActive As Boolean
  Dim nbrCurrRecord, nbrRecords As Integer

  boolTransActive = False

  Set work = DBEngine(0)
  Set rstPackagesReceived = CurrentDb().OpenRecordset("SELECT * FROM PackagesReceived WHERE [PostedDate]=#" & Me!PostedDate & "#", dbOpenDynaset)
  Set rstPostedPackages = CurrentDb().OpenRecordset("PostedPackages", dbOpenDynaset)

  ' Turn the mouse cursor into an hourglass so the user knows we're doing something important.
  DoCmd.Hourglass True

  ' Check to see if we have any records with a matching PostedDate
  If rstPackagesReceived.RecordCount < 1 Or rstPackagesReceived.BOF Or rstPackagesReceived.EOF Then
    ' If we don't have any records, tell the user and then exit the function.
    MsgBox "No packages to transfer for date " & Me!PostedDate & "."

    GoTo FunctionCleanup
  End If

  ' Begin a transaction so we can undo everything if we have problems.
  work.BeginTrans
  boolTransActive = True

  ' Force Access to load all the records so we can get an accurate count below.
  rstPackagesReceived.MoveLast

  ' Set up a couple variables so we can track where we are
  nbrRecords = rstPackagesReceived.RecordCount
  nbrCurrRecord = 1

  ' Go back to the first record so we can execute our loop below.
  rstPackagesReceived.MoveFirst

  ' Loop through each record found with a matching PostedDate
  Do Until rstPackagesReceived.EOF
    ' For each record, add it to the PostedPackages Table.
    With rstPostedPackages
      .AddNew
      !PKG = rstPackagesReceived("PKG")
      !ReceivedDate = rstPackagesReceived("ReceivedDate")
      !CompleteDate = rstPackagesReceived("CompleteDate")
      !PostedDate = rstPackagesReceived("PostedDate")
      .Update
    End With

    ' For each record, delete it from the PackagesReceived Table
    With rstPackagesReceived
      .Delete
    End With

    ' Move to the next record and start our loop over.
    nbrCurrRecord = nbrCurrRecord + 1

    ' Make sure we're not trying to move past the last record.
     rstPackagesReceived.MoveNext
  Loop

  ' If we made it through the loop without running into any errors, save our changes to the database.
  work.CommitTrans
  boolTransActive = False

  ' Tell the user how many records were transferred.
  If Not nbrRecords = 1 Then
    ' If there was a single record transferred, don't refer to the number plurally (is that even a word?).
    MsgBox CStr(nbrRecords) & " package transferred successfully."
  Else
    ' If there were more than 1, then use the plural form.
    MsgBox CStr(nbrRecords) & " packages transferred successfully."
  End If

  GoTo FunctionCleanup

' If we do run into an error, do the following code block.
Error_PostRecords:
  ' If we've started our transaction, we can undo any changes to the database so we don't
  ' lose any data or end up with duplicate records.
  If boolTransActive = True Then
    work.Rollback
  End If

  ' Alert the user that something went wrong.
  MsgBox "The following error occured while attempting to transfer Posted Packages. Please contact your System Administrator." & _
         vbCrLf & vbCrLf & Chr(34) & Err.Description & Chr(34)

  Resume FunctionCleanup

' If everything went well, run the following code block before exiting the function.
FunctionCleanup:
  ' Give the user back their mouse.
  DoCmd.Hourglass False

  ' Clean up our variables
  rstPackagesReceived.Close
  rstPostedPackages.Close

  Set work = Nothing
  Set rstPackagesReceived = Nothing
  Set rstPostedPackages = Nothing

  Exit Sub

The changed sections are in bold.