Moving records from one database to another database

[powelly]

I have a Delete button with this code atached

Private Sub Delete_Click()
 
On Error GoTo Err_DoArchive
  Dim ws As DAO.Workspace
  Dim db As DAO.Database
  Dim bInTrans As Boolean
  Dim strSql As String
  Dim strMsg As String
  Dim r As String
 
If IsNull(Combo15) Or Combo15 = "" Then
MsgBox "You must select a PATIENT", vbOKOnly, "Select A PATIENT"
Exit Sub
End If
 
r = MsgBox("!!!WARNING!!! Are you sure you want to DELETE this PATIENTS FILE this CAN NOT be UNDONE!!", vbYesNo, "!!!!WARNING!!!!      Deletion of PATIENTS File       !!!!WARNING!!!!")
If r = 6 Then GoTo YES Else GoTo NO
 
NO:
    Me.NotSick = False
    DoCmd.Save
    DoCmd.Close
Exit Sub
 
YES:
    DoCmd.Save
 
  Set ws = DBEngine(0)
  ws.BeginTrans
  bInTrans = True
  Set db = ws(0)
 
 
  strSql = "INSERT INTO Deleted ( Id, FirstName, Surname, Dob, Doctor, Diagnosis, Notes ) " & _
    "IN ""x:\SickList\Archived.mdb"" " & _
    "SELECT Id, FirstName, Surname, Dob, Doctor, Diagnosis, Notes FROM qfound WHERE (NotSick = true);"
  db.Execute strSql, dbFailOnError
 
  strSql = "DELETE FROM qfound WHERE (NotSick = true);"
  db.Execute strSql, dbFailOnError
 
strMsg = "Archive " & db.RecordsAffected & " record(s)?"
  If MsgBox(strMsg, vbOKCancel + vbQuestion, "Confirm") = vbOK Then
    ws.CommitTrans
    bInTrans = False
  End If
 
Exit_DoArchive:
 
  On Error Resume Next
  Set db = Nothing
  If bInTrans Then
    ws.Rollback
  End If
  Set ws = Nothing
  DoCmd.Close
  MsgBox "Patient Deleted"
  Exit Sub
 
Err_DoArchive:
  MsgBox Err.Description, vbExclamation, "Archiving failed: Error " & Err.Number
  Resume Exit_DoArchive
  End Sub

The field NotSick is set to true when someone selects a name from a combobox
by using the following code

Private Sub Combo15_AfterUpdate()
    Me.RecordsetClone.FindFirst "[ID] = " & Me![Combo15]
    Me.Bookmark = Me.RecordsetClone.Bookmark
    foundme = Me.Bookmark
    Me.NotSick = True
    DoCmd.Save
End Sub

it works but the problem is you have to close form and then go back in and try again at lest once

can anyone give me some advice on how to fix this problem

thank you in advance for any help ;-)

[NeoPa]

Can you explain what it is you're trying to do with this code (Just the AfterUpdate procedure).
I can't see any sensible logic to it, but then perhaps that's because I don't know what you're trying to achieve.

[powelly]

Sorry

I`m doing this as i don`t want to lose any information when some one is deleted and i don`t want them in the same data base.

The code searches a feild (NotSick) that is true which is set from the user selecting a person then the patient is exported to my other database then that same patient is deleted.

Hope this clears my idea up a bit

thank you

[NeoPa]

Maybe someone can understand what you want better than I can, but I don't think you've actually said anywhere what isn't happening as you would like.
I could ask some general questions as to why you seem to want to save the design of your form in your code (DoCmd.Save), but I don't think that's what you're trying to ask about.
You're not even asking how to do what you want to do. you seem to have you ideas about that, but something isn't to your liking. My problem is that you don't tell me what this is (other than referrring to it obliquely).
I get the concept of what you're trying to do but not of what isn't working for you.

[powelly]

DoCmd.Save was a mistake in the code it has been removed but problem still exist

The problem (bottom of page) is i have two databases one called sicklist and one archived when a patient is selected on the deleted Form the following code runs

Private Sub Combo15_AfterUpdate()
    Me.RecordsetClone.FindFirst "[ID] = " & Me![Combo15]
    Me.Bookmark = Me.RecordsetClone.Bookmark
    foundme = Me.Bookmark
    Me.NotSick = True
End Sub

this just sets patient to be archived and then deleted
due to the field(NotSick = true)
the code for the archiving and deletion is

Private Sub Delete_Click()
 
On Error GoTo Err_DoArchive
  Dim ws As DAO.Workspace
  Dim db As DAO.Database
  Dim bInTrans As Boolean
  Dim strSql As String
  Dim strMsg As String
  Dim r As String
 
If IsNull(Combo15) Or Combo15 = "" Then
MsgBox "You must select a PATIENT", vbOKOnly, "Select A PATIENT"
Exit Sub
End If
 
r = MsgBox("!!!WARNING!!! Are you sure you want to DELETE this PATIENTS FILE this CAN NOT be UNDONE!!", vbYesNo, "!!!!WARNING!!!!      Deletion of PATIENTS File       !!!!WARNING!!!!")
If r = 6 Then GoTo YES Else GoTo NO
 
NO:
    Me.NotSick = False
    DoCmd.Save
    DoCmd.Close
Exit Sub
 
YES:
    DoCmd.Save
 
  Set ws = DBEngine(0)
  ws.BeginTrans
  bInTrans = True
  Set db = ws(0)
 
 
  strSql = "INSERT INTO Deleted ( Id, FirstName, Surname, Dob, Doctor, Diagnosis, Notes ) " & _
    "IN ""x:\SickList\Archived.mdb"" " & _
    "SELECT Id, FirstName, Surname, Dob, Doctor, Diagnosis, Notes FROM qfound WHERE (NotSick = true);"
  db.Execute strSql, dbFailOnError
 
  strSql = "DELETE FROM qfound WHERE (NotSick = true);"
  db.Execute strSql, dbFailOnError
 
strMsg = "Archive " & db.RecordsAffected & " record(s)?"
  If MsgBox(strMsg, vbOKCancel + vbQuestion, "Confirm") = vbOK Then
    ws.CommitTrans
    bInTrans = False
  End If
 
Exit_DoArchive:
 
  On Error Resume Next
  Set db = Nothing
  If bInTrans Then
    ws.Rollback
  End If
  Set ws = Nothing
  DoCmd.Close
  MsgBox "Patient Deleted"
  Exit Sub
 
Err_DoArchive:
  MsgBox Err.Description, vbExclamation, "Archiving failed: Error " & Err.Number
  Resume Exit_DoArchive
  End Sub

PROBLEM is I have to close form and re open the form and re run the code to make the archiving and deletion to finish i would like it to run in 1 open instead of closing & reopening the form to make it finish the archiving and deletion is this possible and i hope this makes it easer to understand

[NeoPa]

is this possible and i hope this makes it easer to understand

No, not really.
No punctuation; and random words left out. It didn't make much sense to me and I'm not going to waste my time trying to understand, when you can't be bothered to follow the guidelines and make it clear.
Would this make any sense to you? I doubt it.
You've been told once that it makes little sense. It seems you've not made any effort to make it clearer. I will try to help if and when I understand what you're saying without having to read it through over and over again.

[Lfuboi]

It sounds like your Form is just not updating the information after the data has changed. Because of that, you have to close the form and reopen it to show the data change.

Maybe a simple solution to this would be using the Command Button Wizard, choose "Form Operations" and choose "Refresh Form Data."

This will prevent you from having to close out your Form and reopen it.

It looks like you're WAY ahead of me in Access knowledge. I'm still wet behind the ears. I don't know anything about the code you have...I don't even know what an expression is, yet. But it sounds like you're just annoyed that you have to close and restart your form...and I think this is a simple solution.

[powelly]

Thanks Lfuboi for your reply yes thats the problem i`m having

Your suggestion

Maybe a simple solution to this would be using the Command Button Wizard, choose "Form Operations" and choose "Refresh Form Data."

is on the right track but unlucky the code will not Re Run :-(

thanks again you gave me something to look into, to fix the problem

i`ll post any new info or the fix to this problem

Cheers :-)

[powelly]

I have found a NEAR fix but still some times it won`t work straight away which does not matter because when the user opens another form it will finish the code when they go back to main menu

I split the code into different parts, to try and make it work more efficiently

On Activate

Private Sub Form_Activate()
DoCmd.Maximize
On Error GoTo Err_DoArchive
  Dim ws As DAO.Workspace
  Dim db As DAO.Database
  Dim bInTrans As Boolean
  Dim strSql As String
  Dim strMsg As String
 
 
  Set ws = DBEngine(0)
  ws.BeginTrans
  bInTrans = True
  Set db = ws(0)
 
  strSql = "INSERT INTO Deleted ( Id, FirstName, Surname, Dob, Doctor, Diagnosis, Notes ) " & _
    "IN ""x:\SickList\Archived.mdb"" " & _
    "SELECT Id, FirstName, Surname, Dob, Doctor, Diagnosis, Notes FROM [all] WHERE (NotSick = true);"
  db.Execute strSql, dbFailOnError
 
  strSql = "DELETE FROM [all] WHERE (NotSick = true);"
  db.Execute strSql, dbFailOnError
 
    ws.CommitTrans
    bInTrans = False
 
Exit_DoArchive:
 
  On Error Resume Next
  Set db = Nothing
  If bInTrans Then
    ws.Rollback
  End If
  Set ws = Nothing
  Exit Sub
 
Err_DoArchive:
  MsgBox Err.Description, vbExclamation, "Archiving failed: Error " & Err.Number
  Resume Exit_DoArchive
 
Exit Sub
 
End Sub

and
On Open

Private Sub Form_Open(Cancel As Integer)
 
    Dim dbsSickList As Database
    Dim rstAll As DAO.Recordset
    Dim strEntrydate As String
    Dim oldate
 
Set dbsSickList = OpenDatabase("x:\SickList\SickList.mdb")
Set rstAll = _
     dbsSickList.OpenRecordset("All", _
     dbOpenDynaset)
 
 
    oldate = Date
    oldate = DateAdd("d", -31, oldate)
 
 
    With rstAll
    .MoveFirst
 
Search:
   Do While Not .EOF
      If !Entrydate < oldate Then GoTo Old Else GoTo Newd
 
 
Newd:
.MoveNext
    GoTo Search
 
Old:
.Edit
!NotSick = True
.Update
.MoveNext
GoTo Search
Loop
End With
 
    rstAll.Close
    Set rstAll = Nothing
    Set dbsSickList = Nothing
 
  End Sub

this is not a complete fix but it may help some one to fix a problem they have i will continue posting this until it is working like i would like it to

cheers to all